perm filename FOO[S,NET] blob sn#719204 filedate 1983-07-04 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00178 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00017 00002	III DISPLAY PACKAGE - D. POOLE - NOV 1968
C00020 00003	PBAKCL GRBAKB GRVECB SIZSBU POSSBU LHCSBU GHCSBU LEWRBP LEWRBT LEWJBP HLINES HGLTCH BDUNIT BD300 BD1200 BD2400 BD4800 BD9600 B10000 BDMAX DMBAUD BDDFT BDDFT PCDFT PADDFT NGSIII NGSDD NGSDM NLSIII NLSDM NLSDD NLSDD YPIII YPDD YPDM NDDSPQ YLINE HGTIII HGTDD HGTDD HGTDM MAXLIN MINLIN MAXCOL MINCOL OUTNUM LINELN DDLINELN DDLINELN CBLKBT TBLKBT FBLKBT
C00027 00004	DWPINI DWPERR DPYATL
C00030 00005	DPYMAK DPYM0 DPYM0A DPYM1
C00034 00006	DPYMNG DPYMGS DPYM3
C00041 00007	 DPYXIT DPYXTL DPYM9 SCNFFJ SCNFIX SONPPJ SCNONJ
C00047 00008	DPYM4 DPYM5 DPYM6 DPYM7 DPYM8 PPSET
C00050 00009	DPYM2 DDWIPE DDMAP DDMAP1 DDMAP3
C00054 00010	DPYKIL DPYK00 DPYKI8 DPYKI4
C00059 00011	DMCLRU CLKFLS CLKFL1 CLKFL2
C00062 00012	SPIONJ DPYKI2 DPYKI3 DPYKL1 DPNONO DPNOT4
C00065 00013	 TPTINT TPTIN2 TPTIN3 DPKSTR DPKST2 DPKRLP DPKROL DPNODP DPNOT3 DPYKML
C00070 00014	DPYK12 DPYK11 DPYKFS DPYKF1 DPYKF2 DPYKF3
C00074 00015	DPYKS7 DPYKS9 DPYKI9 DPYK9 DPYKI7 DPYKI6 SCLOCK SCLOC2 CLRLED DPYKER
C00079 00016	DPYINT NOSTOP L6 L5 L3 DPYXIT
C00082 00017	DPERR DPENNX NOADDR NOMBSY NODPLK L8 L9
C00086 00018	L2 L1 L1A L4 L7
C00088 00019	PPINIT PPI1 PPI3 -- PAGE PRINTER STUFF
C00092 00020	PPINI2 PPXFT
C00096 00021	PPFSGE CGETFS UGFS2 UGETFS CGIVFS UGIVFS GETQ UGETF2 UGETF1 UGETF3 UGETF4
C00101 00022	BELOW IS THE PROTOTYPICAL P. OF P. CONTROL BLOCK.
C00108 00023	DTYO DPYTYO TYO0
C00111 00024	TYO5 TYO1 TYO2 TYO7 DELNOW IIILED IIILE2
C00116 00025	TYO4 PR1TAB PR1TB1
C00118 00026	PRCR PRCR3 PRCR2 PUT2CH PUTCH1 PUT2C3 PUT2C4 PUT2C2
C00121 00027	PR1ECR PR1EC1 PR1EC3 SETLL
C00124 00028	PR1EC2 PR1EOL PR1EO2 PREOGL
C00126 00029	EXTBUF L2 L1 GBLK
C00130 00030	GLITCH GLTCH1 GLTCH3 GLTCH9 PR1EL4 ADJSIZ CNTWRP GLTCH8 GLTCH4 GLTCH5 GLTCH7 GLTCH6
C00134 00031	EOLSET EOLSE2 EOLSE3
C00137 00032	GLNADR GLNAD1 GLNAD2 GLNAD3 GLNAD4 GLNAD6
C00138 00033	GLNAD5 GLNAD7 HELPX
C00140 00034	POSLIN POSLDD POSLDM POSLD2 POSLII
C00142 00035	FBLK FB1 PR1FRE PR1ER2
C00145 00036	PR1ER3 PR1ERR PR1ER1
C00148 00037	PPOUT SETRST PPRST
C00150 00038	ERRP2 ERRP3
C00151 00039	PPFND1 PFL2 PPFND PPFER
C00155 00040	PPREL PPREL2 PPREL3 PPREL4 PPSEL0 CLKREL
C00160 00041	PPSELU PPSEL PPSELN PPSELX
C00163 00042	PPACT0 PPACT PACTL1 PACTL2 PACTL3 PACTL4
C00167 00043	PPWAIT PPWAT2 APSCON HPWAIT HPWAID
C00171 00044	PPYPOS PPYPO1 PPYPO4 REFPAG PPYPO6 PPYPO3
C00174 00045	PPYPO2 PPYPO5 PPYPDN PPYPDM
C00177 00046	PPERS
C00180 00047	DMERS PTMOVE PTMOV1 PTMOV2 PTMOV3 PTMOV4
C00183 00048	PPXSIZ PPX1 PPX2 PPXERR
C00187 00049	DPYCLK CLKL1 CLKRTN DDFSER
C00192 00050	WHOQUE WHOQ2 WHOQ4 WHOQ3 WHOQ4 WHOQ1 WHORPT
C00198 00051	WHOQDM WHOQD2
C00201 00052	FREE GETFS POPAJ CLKWAT ARRRGH
C00203 00053	PRGFND PRGF1 PRGF2 PRGF3 PRGFER PRGFE1 DDFND
C00206 00054	PPIOT
C00207 00055	DPYCLR DPYRST PPCLR PPC1 PPC3 PPC2 PPC4 PPCLRX
C00213 00056	WHONOW PPNST2 PPNSET PPNST1 SETPHD PPGSET PPGST2 PPGST1 DMNORM
C00216 00057	PPLSET PPYSET PPYS2 PPYDD PPYDM PPYS3 PPYIII
C00219 00058	PPHLD PPHLD1 PPHLD2 AC1CLK
C00221 00059	PPSPY PPSPY2 PPINFO PPSPIE PPINF1 PPSPY1 PPLNCT
C00229 00060	LEYPOS CURSET FOOFRL FREEL
C00232 00061	DMUPG0 DMUPG DMUPG2 DMUPG3 DMUPGE CHASER CHASEM CHASE3 FREEZE RSTFRZ
C00243 00062	DMUWHO DMUDUN DMUCLK DMUCER DMUCL2 DMUUUO
C00247 00063	QDMPP QDMGLC QDMERS QDM
C00250 00064	UPSIII UPGRIN UPGIOT T2 PBSZ SIZE PGWC PGSA PGNP UPGRNS L1
C00256 00065	LOOP UPCHK UPCHK1 UPGTB SPECOP DONE UPREL UPREL1 UPRERR UWC0
C00263 00066	SPCIII SPCDD SPCGRN GRSLM DDCMD JLINK SPCC1 SPCC2 GSLCHK GSLCH1 SPCJMS SPCILM
C00267 00067	SPCTBL SELCHK LOOPS DCHNOK
C00269 00068	ADRRST ADROP ILLAD ILL1 ILLJMS HLTOP UPGER1
C00272 00069	DDUPG DDCWL DDCINC DDUIII DDGRIN
C00276 00070	DDWAIT APRONJ UPGQ
C00280 00071	DDSCHN
C00283 00072	CHKAD CHKAC1 CHKAC2 CHKAC3 CHKAC4 CHKADR
C00286 00073	CHAD MYCHN ILLCHN
C00288 00074	PGSET PGSETA PGSET1 PGSET2 PGSL1
C00291 00075	DPYERR DPYER1
C00293 00076	UPGMVM UPGMOV UPGMV
C00296 00077	PGIOT PGMAX PGSEL VPGACT PGACT PGACL PGAC1
C00299 00078	PGCLR PGCLR1 PGINFO PGCLP PGSZ PGCNT PGXLP
C00302 00079	DPYTY1 DPYERT DPYTYP DPYTY4 DPYTY5 DPYTY2 DPYTY6 DPYTY3
C00306 00080	DPYTL1 DPYTL0 DPYTL2 DPTL2A DPTL2B
C00310 00081	DPYTL3 DPYTL4 DPYTER
C00312 00082	STAR0 STAR IISTAR
C00315 00083	DMSTAR DMSTA2 UNHDM CHASPP CHASP3 CHASP4
C00318 00084	UNHOLD UNHIII
C00321 00085	DPTDD DPTDDK DPYTLN DPYTIM DPYTL5
C00323 00086	QDMCLK QDMR QDMR1 QDMR2
C00327 00087	DMNXBK DMNONX DMNON3 DMNON2 DMNON4
C00330 00088	DMNON5 DMNON6 DMNON7 DMNOQB DMNOHD DMQGLC DMXSIZ DMPPST STRTEX
C00334 00089	DMSHFT DMSHF0 DMSHF1 DMSHF2 DMSHF3 DMSHF4
C00338 00090	DMSHF5 GLTCHX GLTCHZ DMSTHD
C00342 00091	START RESET ENB LOSENB DAMMIT DDUSRM DDNXM USUAL FIELD INT LOSE
C00344 00092	QLINE QFIELD QHPOS QLINK QWAKE QCOUNT QTIME QINSTR QPDL QPDL2 QACCT QLENGTH QFLAGS QTAKR QDMCNT QXY QLINK QWAKE QCOUNT QFREE QINSTR QXYLOC QPUTR QTEXT QTEXTL
C00348 00093	QDDR DOXFR
C00352 00094	QDD1 NOPAGE
C00355 00095	DPTDL DPYTLX AC2CLK
C00359 00096	LEERS LEERSN RFPCS LEERS2 LEERS3 LEPGC LEPGC2
C00362 00097	REFLIX REFLINE REFLN2
C00365 00098	LECLRS LECLR2 LECLR3 LECLR4
C00369 00099	LERFP LERFPW Q2BLCK LERFP1
C00372 00100	GET2Q LERELE PPCLB
C00374 00101	LERDM LEPDM LEPDM0 LEPDM4 LEPDM1
C00378 00102	DMFORC LEPDM2 LEPDM5 LEPDM3 TBDONE INDONE LEPDMC
C00384 00103	USFLUS USFLU3 PPFLUS PPFLU3 PPFLU2 DMFLUS DMFLU2 DMFLU3
C00388 00104	DMLED0 DMLED5 DMLED DMLED4 DMLED9 DMLED7 STRTDM STRTD2
C00393 00105	DMNDDB DMEOSL
C00395 00106	DPLEDR DPLED DPLED2 DPLED3 DPLEVS
C00399 00107	DPLEOK DPLGC1 DPLGC2
C00402 00108	NOLETX DPTL14 DPLGCP
C00405 00109	DPTLE1 DPTL1A DPTL1B DPTL1C DPTL1D
C00409 00110	DPTLE6 DPTLE9 DPTLE7 DPTLE2 DPTLE8 DPTL11 DPTLE3
C00412 00111	DPTLE4 DPTL12 DPTLE5 - EVERYBODY COMES HERE TO EXIT
C00414 00112	DPWT DPWT1 DPWT2
C00417 00113	DPEOSL
C00419 00114	DPEC DPEOPC DPEC1 DPEC2
C00421 00115	DPWPC DPWPC1 DPWPC2 DPWC DPWB
C00424 00116	QBLOCK QBLK QBLDBG REQBLK QGRFLS
C00430 00117	QBLCLK QBLCLC QBLGO
C00434 00118	QBL1 CNXTFR QBL6 QBL7
C00437 00119	QOOB GIVQB QBLERR WAKEQ
C00440 00120	QBL3 MAKFRM QBL4
C00443 00121	QBL8 QBL5 QBL9 QBLXIT
C00445 00122	DDQCHK DDQCH1 DDQCH4 DDQCE3 DDQCE2
C00447 00123	DDQCE1 DDCKR1 DDCKR3 DDCHER DDTSCH DDTSC2 DDTSC1
C00449 00124	DDTSE4 DDTSE3 DDTSE2 DDTSE1 DDCKR2
C00451 00125	SCPIER QBNODD QBNOD2
C00455 00126	GGRPH G1COM G2COM
C00456 00127	DDSTRT NEWFRM SCNLOP
C00459 00128	RESCAN DDEXIT
C00461 00129	DDREQ DDREQ1 DDREQ3 DDREQ2 PPWAKE USWKLE
C00464 00130	DMDEQ DEQ DEQWAK PPWAK2 DEQ2
C00467 00131	DEQ1 GIVQ DEQERR
C00469 00132	PPXFR
C00474 00133	PPXFR1 PPXFR2 PPXFR3 PPXFR4 ILLPP
C00476 00134	ERASE CWAIT
C00481 00135	CURSOR CURNOR CURREL CDX CURS2 CURS1
C00487 00136	CURERR CMAKE CMAKE1 CMAKE2
C00490 00137	LEXFR LEXFR4 LEXNOR LEXREL
C00495 00138	LEXFR1 LEXFR2 LEXFR3
C00497 00139	WSE WSENOR WSEREL WHOWRT WHOWR2 WHOWR4 WHOWR3 WHOWR5 WHOWR1
C00503 00140	POG POG0 POG1 POGCLK  -  USER DATA DISC PROGRAM
C00507 00141	PPSTAR POGX1 POGX2
C00510 00142	ISYNCU ISYNC DDISM DDINT DDINT2
C00514 00143	DDNX DDINT1 DDCMR DDCLK DDIXIT DDIXI1
C00517 00144	DDILL
C00519 00145	GSENDC GSEND1 GSEND2 GSENDZ GSENDY
C00522 00146	GRNSIM GRNSI1 GRNLOP
C00525 00147	GRSDSP GRNILL GRNJM0 GRNJMP GHALT WLVW ISABS WSVW IIISV GSHV GCOM1 GCOM2 GRNPAR GRNPDS $GMSEL $GMSII
C00535 00148	GPCHK GPTAB GPWID GPLDC GPWGD GPWAC GPLER GPLEA GPLEB GPLEC GPLLR GPLLA GPLLB GPLLC
C00541 00149	GCDD GCDSP CG6 CG0 CG1 GCMPM GCCSND GGRAPH CG2 CG7 CG3 CG4 CG5 CG4COM
C00549 00150	MAKEV MKVRTN VVIS ADDIN
C00553 00151	GRNCHR STALE CLOOP SNDIT SPCRET NOTYET GR177 GC177 GC11 GC15 GCEOLD GCCEOL GCCEO2 GCCEO3 GC12 SNDSPC GTXLP
C00562 00152	DDLNK DDALST DDBADB DDKILL DDANYW DDSMSK DDUSR DUSRMK DTTUSR DTTL0 DSPUSR DDUSR2 DDAVLU DDDETU DDPRVT DDELNK DDCLST DDGBIT DDSBIT DDGMOD DDUSET VDOP VDPERM VDABSO VDXBIT
C00566 00153	DDINI DDINI1 DDINI3 DDINI2
C00569 00154	DDAVST DDLIST VDSYNC
C00572 00155	DDCHAN DDCDSP DDAREL DDARL1
C00575 00156	DDUSRT DDCREL DDCRL1 DDREL DDQNTA DDQER4 DDQER3 DDQER2 DDQFIX DDREL2 DDQDET
C00583 00157	DDCGET DDAGE1 DDCG1 DDAGE3 DDAGET DDAGE2 DDGET2 DDGET3
C00587 00158	DDFLSH DDFL00 DDFLS0 DDFL01 DDFLS3 DDFLS2 DDFLS4 DDFL99 DDFLS7 DDFLS8 DDFL88 DDFLS9 DDFLSX FINDDD FINDD1 FINDDL FINDD2 FINDD3 FINDDF FINDDN FINDDQ
C00594 00159	DDCHEK DDCSGT DDSGET DDCFND
C00596 00160	DDCSST DDSSET VDBIT VDSTR1
C00599 00161	VDSTRU VDSTU1 VDSTU2 VDOUT VDOUT1 VDOUT2 VDOUT3
C00601 00162	VDOUP0 VDOUTP VDOUP1 VDOUP2
C00603 00163	VDSMAP VDMAP1 VDMP1A
C00607 00164	VDMAP2 VDMAP3 VDMP30 VDMP31 VDGTIE VDMP32 VDMAP5 VDMAP4 VDDSP VDSTIE VDSTI1
C00610 00165	VDSET VDIOR VDIOR1 VDACM VDRST VDRST1
C00612 00166	VDNORM VDRST2 VDNOR2 VDNOR3
C00614 00167	VDWCHK VDWCHL VDWOK VDWLUZ VDCCHK VDCCK0 VDCCK1 VDCCK5 VDCCK4 VDCCK2 VDCCK3 VDCCHK VDCCK0 VDCCK1 VDCCK2 VDCCK3
C00618 00168	BEGIN WHOSER  ↔ SUBTTL WHO LINE GENERATOR 	WHOINI
C00622 00169	WDMPTY NWHOTX NWHOKL NWHOTX WHOSER WHODO9 WHODO8 WHOD8A WHOEGR WHOIII WHODO WHODO9 WHODO8 EXTRDM WHOPTY WHOPT2 EXTRGR EXTRDD EXTRG2 EXTRA0 EXTRA1 WHODOE
C00634 00170	WHODO4 WHODO3 WHODO2 WHODO5 WHODO1 WHOD1A DMWOK
C00638 00171	WHOCLR WHODM WHODM2 DMUSLN DMUSL3 DMUSL4 DMWCHK DMWCH3
C00642 00172	WHOSIX WHOSXX WSDPAD WSDPD3 WSDPD2 WSDPD0 WSDNUL WSDDEC WSDOCT WSDPD1 WPER2D W0PD2 DECPDF WHPRNT
C00646 00173	WHITTY WHIOWQ WHIOW2 ALWAYS ALWA01 ALWA00 ALWAY3 NOIDLE DOIDLE ALWY3A ALWY3B XTALL NOXTIM NOXTM1 DOTIME WHOTIM WHRMIN WMIN LNGMIN
C00657 00174	WHOTTY WHOSET WHOLIN
C00662 00175	WLRET1 WLRET RTMPER NOIDL2 XTMPER XTMPR1 NOXPER WALIAS
C00669 00176	WHOSYS NMTRNL NONULL TEMPOK CENTOK WHOSY1 WHOII0 DMCNTL D12LPA D12LPB WRUN1 WRUN2 WRUN2A
C00684 00177	WHODDC WHODD2 WHONOQ WHODD5 WHODD3 WHOGRL
C00687 00178	WHOFI3 WHOFI2 WHFGRN WHFCUR WHFDD WHFDD WHFDM WHFIII WHOFIL WHFIL2 SHOWIT SHOWI2
C00695 ENDMK
C⊗;
SUBTTL III DISPLAY PACKAGE - D. POOLE - NOV 1968
COMMENT ⊗ 
	THESE ARE THE GLORIOUS, WORLD-SAVING III DISPLAY
ROUTINES.  FOR THEIR FIRST TRICK, THEY WILL IMPERSONATE
W. F. WEIHER, THUS STARTING THE PROGRAM ON A NOTE OF
LIGHT HUMOR.

⊗
BEGIN DPYSER

IFE FTF2,<	;Different no-op from most places.  LINED/WHOSER use different one.
DISNOP←←14	;ACTUALLY RST, BUT A GOOD NOP WITH ALL BITS OFF.
>;IFE FTF2
IFN FTGRIN,<
GMSEL←←30	; GRINNELL MODE SELECT - UPSIII AND UPGRIN IN LH
>;IFN FTGRIN

DEFINE ERMS (X) {JSA J,ERRP
POINT 7,[ASCIZ ⊗X
⊗]
}

GLOBAL DDTAB,JB2SWP,HOMEPT	;STUPID FAIL

IFE FTGRIN,<
↑POSOFF←←1	;Offset from wholine starting address of positioning word.
↑RETOFF←←3	;Offset from wholine starting address and system wholine return addr
		;Allows RETOFF-1 words of display cmds plus one jump word
↑STRTCL←←2	;DD text column number where CR positions us
>;IFE FTGRIN

IFN FTGRIN,<
↑GWCOFF←←0	;Offset from wholine starting address of channel/subch select
↑DLTOFF←←2	;Offset from wholine starting address of delta-X/-Y word
↑POSOFF←←3	;Offset from wholine starting address of positioning word.
↑RETOFF←←5	;Offset from wholine starting address of system wholine return addr
		;Allows RETOFF-1 words of display cmds plus one jump word
↑STRTCL←←1	;Text column number where CR positions us
>;IFN FTGRIN
;PBAKCL GRBAKB GRVECB SIZSBU POSSBU LHCSBU GHCSBU LEWRBP LEWRBT LEWJBP HLINES HGLTCH BDUNIT BD300 BD1200 BD2400 BD4800 BD9600 B10000 BDMAX DMBAUD BDDFT BDDFT PCDFT PADDFT NGSIII NGSDD NGSDM NLSIII NLSDM NLSDD NLSDD YPIII YPDD YPDM NDDSPQ YLINE HGTIII HGTDD HGTDD HGTDM MAXLIN MINLIN MAXCOL MINCOL OUTNUM LINELN DDLINELN DDLINELN CBLKBT TBLKBT FBLKBT

;BYTE POINTERS
↑PBAKCL:
IFE FTGRIN,<
	POINT 1,DDCW(AC2),5	;DD bit on means dark background
>;IFE FTGRIN
IFN FTGRIN,<
	POINT 1,GRCW2(AC2),8	;Grinnell bit off means dark background
GRBAKB←←4*G.WMB			;LH value of background bit
GRVECB←←4*G.WMV			;LH value of vector (¬rectilinear) bit
>;IFN FTGRIN

; BYTE POINTERS INTO BITS THAT SAY SIZE SET BY USER OR UUO

SIZSBU:	POINT 1,GWORD(DDB),0	; IF 1, SAYS LINES/GLITCH OR GLITCHES/PAGE SET BY USER LAST
POSSBU:	POINT 1,GWORD(DDB),1	; SAYS Y-POS. SET BY USER COMMAND (RATHER THAN UUO)
LHCSBU:	POINT 1,GWORD(DDB),2	; SAME FOR LINE HOLD COUNT
GHCSBU:	POINT 1,GWORD(DDB),3	; SAME FOR GLITCH HOLD COUNT
LEWRBP:	POINT 1,GWORD(DDB),4	; 1 if line editor has wrapped around since PPINFO
↑LEWJBP:POINT 1,GWORD(J),4	; same bit, different byte pointer for LINED
LEWRBT←←20000			; LH bit to match LEWRBP/LEWJBP
HLINES:	POINT 9,GWORD(DDB),17	; POINTS TO NUMBER OF LINES BEFORE HOLDING
HGLTCH:	POINT 9,GWORD(DDB),26	; POINTS TO NUMBER OF GLITCHES BEFORE HOLDING
;	POINT 9,GWORD(DDB),35	; CHAR WHICH ACTIVATED LINED

;DM PADDING/BAUD RATE DATA
↑BDUNIT←←=50		;MINIMUM SIGNIFICANCE IN STORED BAUD RATE FOR DM PADDING
↑BD300←←=300/BDUNIT	;STORED VALUES FOR VARIOUS BAUD RATES USED IN 
↑BD1200←←=1200/BDUNIT	; PADDING CALCULATIONS AND INITIALIZATION
↑BD2400←←=2400/BDUNIT
↑BD4800←←=4800/BDUNIT
↑BD9600←←=9600/BDUNIT
↑B10000←←=10000/BDUNIT	;USED FOR CONVERTING MSEC DM EXECUTION TIMES
↑BDMAX←←777		;MAX (CONVERTED) BAUD RATE
↑DMBAUD:POINT 9,PADCNT(TAC1),26	; BAUD RATE USED FOR DM PADDING CALCULATIONS

;Default value for RH of PADCNT cell: baud rate for padding; pad char.
IFE FTLLL,<
↑BDDFT←←BD1200	;default padding baud rate
>;IFE FTLLL
IFN FTLLL,<
↑BDDFT←←BD9600	;default padding baud rate
>;IFN FTLLL
↑PCDFT←←1	;default padding char
↑PADDFT:BYTE(9)0,0,BDDFT,PCDFT

; NORMAL VALUES FOR THE PAGE PRINTER

NGSIII←←14	; GLITCHES/PAGE FOR III DISPLAYS
IFE FTGRIN,<	; GRINNELL USES DMNORM TO FIGURE GLITCHES/PAGE
NGSDD←←4	; GLITCHES/PAGE FOR DD DISPLAYS
>;IFE FTGRIN
NGSDM←←7	; GLITCHES/PAGE FOR DM DISPLAYS
NLSIII←←2	; LINES/GLITCH FOR III
NLSDM←←3	; LINES/GLITCH FOR DM
IFN FTGRIN,<
NLSDD←←NLSDM	; MUST BE SAME AS DM, SO THAT DMNORM CAN BE USED FOR GRINNELL
>;IFN FTGRIN
IFE FTGRIN,<
NLSDD←←11	; LINES/GLITCH FOR DD
>;IFE FTGRIN
YPIII←←600	; Y-POSITION FOR III
YPDD←←660	; Y-POSITION FOR DD (line 4 of 40.)
YPDM←←526	; Y-POSITION FOR DM (line 4 of 24.)
↑NDDSPQ←←60	;# SPARE DD/DM QUEUE BLOCKS (TIRED OF BEING SCREWED -REG)
↑YLINE←←4	; Screen line number for default Y position, all displays

↑HGTIII←←=42	;Number of lines on screen for III (slightly arbitrary)
IFE FTGRIN,<
HGTDD←←=40	;Number of lines on screen for DD
>;IFE FTGRIN
IFN FTGRIN,<
HGTDD←←=42	;Number of lines on screen for Grinnell
>;IFN FTGRIN
↑HGTDM←←=24	;Number of lines on screen for DM (default type of DM)

↑MAXLIN←←=62	;Maximum allowable size of DPYHGT (number of lines on screen)
↑MINLIN←←=8	;Minimum   "

;If you change MAXCOL, don't forget to extend the TABSET message in CACDAT.
↑MAXCOL←←=96	;Maximum allowable size of DPYWID (number of columns on screen)
↑MINCOL←←=16	;Minimum   "

OUTNUM←←1	;THIS MANY BLOCKS AT ONCE GET PUT ON DISK. (HA HA)
↑LINELN←←=88	;NO. OF CHARS. PER LINE FOR III
IFE FTGRIN,<
DDLINELN←←=84	; SAME AS ABOVE FOR DATA DISC
>;IFE FTGRIN
IFN FTGRIN,<
DDLINELN←←=73	; SAME AS ABOVE FOR GRINNELL
>;IFN FTGRIN
;DMLINELN←←=80	; SAME FOR DATAMEDIA
CBLKBT←←1	;MAGIC CODE BITS FOR THE (HO, HO) RELOCATING GARBAGE COLLECTOR.
TBLKBT←←4
FBLKBT←←2
;DWPINI DWPERR DPYATL
COMMENT ⊗  THE FOLLOWING IS SYSTEM START TIME INITIALIZING CODE.
 	MUCH OF IT IS IN TEMPORARY FORM.
⊗

↑DWPINI:
IFE FTF2,<
	SKIPE IIIOFF		;SUPPRESSING III TODAY?
	TDZA AC1,AC1		;YES.  FLUSH CONSZ INSTRUCTION
	MOVEI AC1,400000	;NO. SET CONDITION BIT IN DPYCON
	HRRM AC1,DPYCON
	MOVEI TAC,DPYNUM
	MOVEM TAC,DRUNCT	;INIT. PTR. TO NEXT DPY TO RUN.
>;IFE FTF2
IFN FTDD!FTGRIN,<
	MOVEI AC1,2		;INITIALIZE COMMON DD CURSOR BUFFER
	MOVEM AC1,DDCURS+CURB	;BY PROPAGATING A ZERO GRAPHICS WORD DOWN IT
	MOVE AC1,[DDCURS+CURB,,DDCURS+CURB+1]
	BLT AC1,DDCURS+CURB+LCURB-1 ;ALL THE WAY
	HRLOI TAC,377777
	MOVEM TAC,DDCNT
>;IFN FTDD!FTGRIN
	SETZM FSWTHD		;CLEAR FS WAIT LIST.
	SETZM FSWT2H		;AND THE WAIT LIST WAIT LIST.
IFN FTDD!FTGRIN,<
	SETZM DDSTART		; CLEAR ALL THE DATA DISK FLAGS
	SETZM DDRUN
>;IFN FTDD!FTGRIN
IFE FTF2,<
	SETZM STRTBL		; ZERO OUT ALL THE IMPORTANT TABLES
	MOVE TAC,[XWD STRTBL,STRTBL+1]
	BLT TAC,RSTTBL+DPYNUM-1
>;IFE FTF2
	MOVE TAC,[POINT 36,CLKQUE-1,35]
	MOVEM TAC,CLKQ		;INIT. CLOCK QUEUE PTR.
	MOVE TAC,[IOWD LCPDL,CLKPD]	;..ALSO CLOCK PDL.
	MOVEM TAC,DPYPDL
IFE FTF2,<
	MOVSI TAC,770000	; RESTORE AVAILABLE MESSAGES
	HLLM TAC,DPYAVL+1
	HLLM TAC,WHOSEL		; SYSTEM WHO LINE FOR ALL AVAILABLE IIIS
	MOVSI TAC,77		; DESELECT EVERYONE
	HLLM TAC,DPYHLD		; HOLDING MESSAGE TOO
	CONO DDD,10
	PUSHJ P,DDINI
>;IFE FTF2
IFN FTGRIN,<
	CONO GRN,0		; CLEAR INTERRUPT ENABLINGS
>;IFN FTGRIN
	JRST WHOINI

DWPERR:	PUSHJ P,DISGST		;PRINT TIME OF NEW MESSAGE ON CTY
	PUSHJ P,DISMES
	ASCIZ /CATASTROPHIC ERROR FROM DPYSER
/
DPYATL:	PUSHJ P,DISFLUSH
	PUSHJ P,WDDTCA
	HALT .
;DPYMAK DPYM0 DPYM0A DPYM1
; DPYMAKE MAKES UP A DISPLAY PROGRAM HEADER WITH LINE EDITOR BUFFER. IT EXPECTS
; THE LINE NUMBER IN TAC1. PRESERVES ALL OTHER ACCUMULATORS. SKIPS ON SUCCESS.
; ON FAILURE, WILL PLANT A CLOCK REQUEST AND TRY TO GET ONE LATER.

↑DPYMAK:SKIPE LETAB(TAC1)	; DO WE ALREADY HAVE A PROGRAM HEADER?
	JRST CPOPJ1		; YES, GIVE SUCCESS RETURN
	PUSH P,TAC
	PUSH P,DAT
	PUSH P,DDB
	PUSH P,AC1
	PUSH P,AC2
	PUSH P,AC3
	HLRO TAC,LINTAB(TAC1)	;-1 IN LH MEANS NOT DD, RH HAS LINE BITS
	HLL TAC1,LINTAB(TAC1)
IFN FTDD!FTGRIN,<
	TLNN TAC1,DDDLIN
	JRST DPYM1
>;IFN FTDD!FTGRIN
IFN FTGRIN,<
	MOVEI TAC,-DDL0(TAC1)	;For now, store Grinnell number instead of DD chan
>;IFN FTGRIN
IFE FTF2,<
	MOVSI TAC,DTTUSR-DTTL0(TAC1) ;UNHIDDEN TTY STATUS
	SKIPN AC1,DDSPCH	;want special channel?
	JRST DPYM0		;nope
	SETZM DDSPCH		;yup, make sure doesn't happen again
	HRRI TAC,(AC1)		;set channel number we want
	PUSHJ P,DDCGET		;request it
	 JRST DPYXTL		;lost
	JRST DPYM0A		;resume normal operation

DPYM0:	PUSHJ P,DDAGET		;FIRST MAKE SURE WE HAVE A CHANNEL FOR DD
	 JRST DPYXTL		;GO DIRECTLY TO JAIL
DPYM0A:	ANDI TAC,-1		;LEAVE ONLY DD CHANNEL NUMBER (RH)
>;IFE FTF2
DPYM1:	MOVEI AC3,DHFS
	PUSHJ P,SFSGET
	 JRST DPYM8
	HRRZ DDB,AC1
	SETZM (AC1)		; FIRST, ZERO THE THING OUT
	HRLZ AC2,AC1
	HRRI AC2,1(AC1)
	MOVE AC3,AC1
	BLT AC2,DPYLEN-1(AC3)
	MOVEI AC2,DISRST!60	; NOW SET UP THE STARTUP WORD TO RESTORE THE POSITION VECTOR
	HRLI AC2,PRGSAV(AC1)	; THAT WAS STORED LAST TIME THE DPY WAS STOPPED
	MOVEM AC2,(AC1)
	HRLI AC2,LEB+1(AC1)	; THE LINE EDITOR DOES THIS TOO
	MOVEM AC2,LEPPV+4(AC1)
	SETZM LEB(AC1)
	HRLI AC2,LEB(AC1)	; SET UP THE LINE EDITOR CALL
	HRRI AC2,DISJMS
	MOVEM AC2,LEJMS(AC1)
	HRRI AC2,DISJMP		; FILL UP THE LINE EDITOR BUFFER WITH RETURN JUMPS
	MOVEM AC2,LEBUF(AC1)
	HRLI AC2,WHOCALL(AC1)	; MAKE RESTART POINT JUMP BACK TO WHO LINE CALL
	MOVEM AC2,RTJMP(AC1)
	HRLI AC2,LEBUF(AC1)	; NOW BLT THE RETURN JUMP ALL OVER THE
	HRRI AC2,LEBUF+1(AC1)	; LINE EDITOR BUFFER.
	BLT AC2,LEHPOS-1(AC1)
	MOVSI AC3,(TAC)		; DD CHANNEL OR, IF NOT DD, BIT INDICATING DPY TYPE
	HRRI AC3,(TAC1)		; TTY LINE NUMBER
	MOVEM AC3,PRGNUM(DDB)
;DPYMNG DPYMGS DPYM3

IFN FTRANGE,<
	SETZM DMBEG(DDB)	;Don't suppress any user program output
	MOVEI AC3,-1
	MOVEM AC3,DMEND(DDB)
>;FTRANGE
	MOVE AC2,DPYDFT		;Get pointer to default display-type block
	SKIPN DPYDES(TAC1)	;And use that default if no type set up
	MOVEM AC2,DPYDES(TAC1)	;This shouldn't really ever happen....
IFN FTGRIN,<
	TLNN TAC1,DDDLIN	;Is this a Grinnell?
	JRST DPYMNG		;No
	MOVE AC3,GRELSZ(TAC)	;Get default character pixel width and scanline hgt
	HLRZM AC3,DCHWID(DDB)	;Store pixel width in dpy hdr
	HRRZM AC3,DCHHGT(DDB)	;Store scanline height
	HLRZ AC2,GRNDIM(TAC)	;Get pixel/scanline count for this Grinnell
	IDIV AC2,DCHWID(DDB)	;Divide by width of each char
	SUBI AC2,1		;Leave one unused column on left of screen
	MOVEM AC2,DPYWID(DDB)	;That's the number of chars that fit on a line
	HRRZ AC2,GRNDIM(TAC)	;Get scanlines/screen count for this Grinnell
	IDIV AC2,DCHHGT(DDB)	;Divide by height of a text line
	MOVEM AC2,DPYHGT(DDB)	;That's the number of text lines that fit on screen
	JRST DPYMGS

DPYMNG:
>;IFN FTGRIN
IFE FTGRIN,<
	MOVEI AC3,DDLINELN	;Line length on DD
	TLNE TAC1,DISLIN
	MOVEI AC3,LINELN	;For III
	TLNE TAC1,DMLIN
>;IFE FTGRIN
	HLRZ AC3,DPCSIZ(AC2)	;For variable display, get default from DPC block
	MOVEM AC3,DPYWID(DDB)
IFE FTGRIN,<
	MOVEI AC3,HGTDD		;DD screen height
	TLNE TAC1,DISLIN
	MOVEI AC3,HGTIII	;III height
	TLNE TAC1,DMLIN
>;IFE FTGRIN
	HRRZ AC3,DPCSIZ(AC2)	;For variable display, get default from DPC block
	MOVEM AC3,DPYHGT(DDB)	;Set up size of display's screen
DPYMGS:	PUSHJ P,PPINIT		;GET PAGE PRINTER SET UP FOR EACH DPY.
	 JRST DPYM7
	PUSHJ P,PPSET
IFN FTDD!FTGRIN,<
	TLNE TAC1,DDDLIN
	JRST DPYM2		; DO SPECIAL DD STUFF (GET CHANNEL & ERASE IT)
>;IFN FTDD!FTGRIN
IFE FTF2,<
	TLNE TAC1,DMLIN
>;IFE FTF2
	JRST DPYM4		; Now go initialize DM output queues
IFE FTF2,<
	MOVNI AC3,-DPYL0(TAC1)	; MUST BE A III
	MOVE AC2,[BYTE (12)0,7777,DISSEL]
	MOVEM AC2,PSELC(DDB)
	MOVSI AC2,400040	; NOW MAKE UP SELECT WORD
	LSH AC2,(AC3)		; PUT A BIT IN THE FIRST TWO 12-BIT FIELDS
	XOR AC2,[77770000]	; COMPLEMENT THE SECOND FIELD
	IORI AC2,DISSEL
	MOVEM AC2,PSELA(DDB)	; AND THIS IS OUR SELECT WORD
	MOVEM AC2,PSELB(DDB)	; AND OUR SPARE SELECT WORD
	AND AC2,[77B5]		; MASK OUT ALL BUT SELECT BIT
	ANDCAM AC2,DPYAVL+1	; DESELECT THIS CONSOLE FROM AVAILABLE MESSAGE
	ANDCAM AC2,WHOSEL	; DESELECT THIS CONSOLE FROM SYSTEM WHOLINE
	LSH AC2,-=12		; PUT BIT IN 'RESET' FIELD
	IORM AC2,DPYAVL+1	; BE SURE TO RESET THIS CONSOLE TOO
	IORM AC2,WHOSEL		; BE SURE TO RESET THIS CONSOLE TOO
	MOVE AC2,[LVW (-5,-14)]	; MAKE A CURSOR FOR THE LINE EDITOR
	MOVEM AC2,LEPPV+1(DDB)
	MOVE AC2,[LVW (12,0)]
	MOVEM AC2,LEPPV+2(DDB)
	MOVE AC2,[LVW (-5,14)]
	MOVEM AC2,LEPPV+3(DDB)
	MOVE AC2,[LVW (0,0,I)]	; NOW A NULL VECTOR FOR THE LEFT MARGIN
	MOVEM AC2,LELMARG(DDB)
>;IFE FTF2
; MORE INITIALIZE CODE FOR A NEW PROGRAM-LINED-BUFFER THING
DPYM3:
IFE FTGRIN,<
	MOVNI AC1,24000/BLKSIZ	; 24000 WORDS MAXIMUM TOTAL PROGRAMS
>;IFE FTGRIN
IFN FTGRIN,<
	MOVNI AC1,100000/BLKSIZ	; 64K WORDS MAXIMUM TOTAL PROGRAMS
>;IFN FTGRIN
	MOVEM AC1,BLKTOT(DDB)	;HOW MANY MORE BLOCKS EACH USER GETS.
	MOVEI AC1,DISNOP
	MOVEM AC1,WHOCALL(DDB)	;NO WHO LINE YET.
	MOVEM AC1,LEPOS(DDB)	; NORMAL VERTICAL POSITION
	SETZM LEYVAL(DDB)	;No special position for line editor from LEYPOS
	MOVEM AC1,PGCALL(DDB)	;NO PG'S.
	MOVEM AC1,LEPPV(DDB)
	MOVEI AC1,400000
	MOVEM AC1,PRGACT(DDB)	;P OF P 0 ACTIVE.
	MOVEM AC1,USRACT(DDB)
	MOVEI AC1,3		; BUMP NUMBER OF SPARE FREE BLOCKS
	ADDM AC1,DPYFS+SPFSN
	ADDM AC1,SPFSNT
	SETOM GLHCNT(DDB)	;Clear current count to automatic holding
	MOVSI AC1,377777	;LARGE POSITIVE NUMBER
	MOVEM AC1,LHCNT(DDB)	;LOT OF LINES TO COUNT TILL AUTOMATIC HOLDING
	SETZM GWORD(DDB)	;Disable automatic holding, clear all the bits
	MOVSI AC1,400000
	MOVEM AC1,NEVECT(DDB)	;Null is the default ESC for NOEDIT ttys
;⊗ DPYXIT DPYXTL DPYM9 SCNFFJ SCNFIX SONPPJ SCNONJ

; NOW SET UP THE POINTERS IN THE TABLES TO GET THE DP STARTED
; AND STOPPED ON THIS PROGRAM

	HRL AC2,DDB		; NOW INITIALIZE ALL THE APPROPRIATE TABLES
	HRRI AC2,DISJMP		; THIS LITTLE JUMP GOES TO DPYTAB
	HRLI AC3,PRGSTP(DDB)
	HRRI AC3,DISJMS		; THIS LITTLE JUMP GOES TO STPTBL
	HRLI AC1,PSELB(DDB)
	HRRI AC1,DISJMP		; AND THIS LITTLE JUMP WENT WEE WEE WEE
	MOVEI DAT,LETAB(TAC1)	;Give the header a pointer to
	MOVEM DAT,LETBPT(DDB)	; its LETAB entry.
setom ledmz(ddb)	;set up the demilitarized zone to show up overflow bugs
PRINTX LEDMZ(DPY HDR) should be flushed when LE overflow bugs are fixed for good.
	MOVEI DAT,PSELA(DDB)
	SYSPIFF		; ALL THE WAY INTO RSTTBL
	SKIPE LETAB(TAC1)	; DID SOMEONE SNEAK IN UNDER US?
	JRST DPYM5
	HRRZM DDB,LETAB(TAC1)	; INITIALIZE LINE EDITOR TABLE TOO
	SYSPIN
IFN FTDD!FTGRIN,<
	TLNE TAC1,DMLIN
>;IFN FTDD!FTGRIN
	JRST DPYM9		;Erase DM screen and start tty
IFE FTF2,<
	TLNN TAC1,DISLIN
	JRST DPYXIT		;THAT'S ALL FOR DD
	MOVE TAC,[LVW -777,YPIII,I,A,2,2]
	MOVEM TAC,LEDPOS(DDB)	;Set up position word for III line editor
	MOVEM DAT,SELTBL-DPYL0(TAC1)
	MOVEM AC3,STPTBL-DPYL0(TAC1)	;IN THIS ORDER
	MOVEM AC1,PRGSTP(DDB)
	MOVEM AC1,RSTTBL-DPYL0(TAC1)	;WE SHOULDN'T NEED
	MOVEM AC2,STRTBL-DPYL0(TAC1)	;TO KEEP PI'S OFF
>;IFE FTF2
DPYXIT:	AOS -6(P)		;WE HAVE WON
DPYXTL:	POP P,AC3
	POP P,AC2
	POP P,AC1
	POP P,DDB
	POP P,DAT
	POP P,TAC
	POPJ P,

DPYM9:	PUSH P,J
	MOVEI J,(DDB)		;Dpy header address into J for LEPDM2
	SETZM DMFLAG(J)		;Clear all the flags
	MOVE TAC,PADCNT(TAC1)	;MAKE SURE PADDING CHAR ISN'T NULL
	TRNN TAC,377		;IF NO PADDING CHAR SPECIFIED,
	MOVE TAC,PADDFT		; USE DEFAULT PADDING RATE AND CHAR
	MOVEM TAC,PADCNT(TAC1)	;STORE FOR THIS NEW DM
	PUSH P,CHR
	SETZM DMFLAG(J)		;No init done yet
	OFFSCN			;LEPDM2 expects scanner off and turns it on
	PUSHJ P,LEPDM2		;Erase DM screen
	POP P,CHR
	POP P,J
	JRST DPYXIT

↑SCNFFJ:AOSGE SCNCNT
	JSR SCNBUG		;OOPS, IT WAS -2 OR LESS
	PUSH P,AC1
	CONSZ PI,PION		;Maybe here with PI system already off
	SKIPA AC1,[CONO PI,PION]
	MOVSI AC1,(<JFCL>)
	PUSH P,AC1		;Save state of PI system
	SYSPIFF
	CONO PI,SCNOFF!PIOFF	;TURN OFF SCANNER AND REMEMBER WHAT WE DID
	EXCH TAC,OFSPDL		;KEEP PDL OF PLACES WHERE SCANNER WAS WANTED OFF
	PUSH TAC,-2(P)		;PUT OUR RET ADDR INTO OFSPDL
	EXCH TAC,OFSPDL
	POP P,AC1
	XCT AC1			;Restore state of PI system
	POP P,AC1
	POPJ P,

IFN FTIP,<
;Entry names for TOPS-10 code
↑SONPJ1:AOS (P)			;Skip return with scanner on
↑SONPPJ::			;Scanner on
>;IFN FTIP
↑SCNONJ:PUSH P,AC1
	CONSZ PI,PION		;Maybe here with PI system already off
	SKIPA AC1,[CONO PI,PION]
	MOVSI AC1,(<JFCL>)
	PUSH P,AC1		;Save state of PI system
	SYSPIFF
	CONO PI,PIOFF
	EXCH P,OFSPDL
	ADJSP P,-1
	EXCH P,OFSPDL
	SKIPGE SCNCNT
	JSR SCNBU3
	POP P,AC1
	XCT AC1			;Restore state of PI system
	POP P,AC1
	SOSGE SCNCNT
	CONO PI,SCNON		;TURN ON SCANNER IF NO ONE STILL WANTS IT OFF
	POPJ P,
;DPYM4 DPYM5 DPYM6 DPYM7 DPYM8 PPSET

DPYM5:	SYSPIN
IFE FTF2,<
	TLNE TAC1,DDDLIN
	JRST DPYM6
>;IFE FTF2
	PUSHJ P,DPYKFS		;III OR DM -- JUST RET FS
	JRST DPYXIT

IFE FTF2,<
DPYM6:	HRRZM DDB,DPRLSF(DDB)	;DD - DEFER FS RET FOR DDWIPE
	MOVSI TAC,DTTUSR-DTTL0(TAC1)
	HLR TAC,PRGNUM(DDB)
	PUSHJ P,DDREL		;BUT GIVE BACK CHNL NOW
	JRST DPYXIT
>;IFE FTF2

DPYM7:	PUSHJ P,DPYKF2		;RET HDR
	AOSA DPYMF2		;COUNT DPYMAKE FAILURES, TYPE 2 (NO PP FS)
DPYM8:	AOS DPYMF1		;COUNT DPYMAKE FAILURES, TYPE 1 (NO DPY HDR FS)
IFE FTF2,<
	JUMPL TAC,DPYXTL	;JUMP if not DD (see HRLO at DPYMAK)
	HRLI TAC,DTTUSR-DTTL0(TAC1)
	PUSHJ P,DDREL		;RELEASE DD CHNL
>;IFE FTF2
	JRST DPYXTL

↑PPSET:	HRRZM DDB,HEDPTR(AC1)	;MAKE PP0 CONT. BLK. POINT AT HEADER.
	HRLI AC1,DISJMP		;ASSEMBLE JMP TO PP 0.
	MOVSM AC1,PPCALL(DDB)	;HAVE HEADER CALL THE PP.
	HRRZM AC1,CURPP(DDB)	;MAKE P OF P 0 THE CURRENT ONE.
	MOVE AC3,DPYWID(DDB)	;GET DISPLAY WIDTH
	MOVEM AC3,LNLNGT(AC1)	;STORE IN PP
	MOVNM AC3,DPHPOS(AC1)	;STORE REMAINING LENGTH OF CURRENT LINE TOO
	MOVEI AC3,PPCALL+1(DDB)	;RETURN ADDR. TO HEADER FROM PP.
	HRLM AC3,PPRJMP(AC1)	;PUT IN PP RETURN JMP.
	POPJ P,

DPYM4:	MOVEI AC1,DMLEPT-QLINK(DDB)	;Make each DM output
	HRL AC1,AC1			; queue header point to itself
	MOVEM AC1,DMLEPT(DDB)
	MOVEI AC1,DMSPPT-QLINK(DDB)
	HRL AC1,AC1
	MOVEM AC1,DMSPPT(DDB)
	MOVEI AC1,DMPPPT-QLINK(DDB)
	HRL AC1,AC1
	MOVEM AC1,DMPPPT(DDB)
	MOVEI AC1,DMUSER-QLINK(DDB)
	HRL AC1,AC1
	MOVEM AC1,DMUSER(DDB)
	MOVEI AC1,DMWHO-QLINK(DDB)
	HRL AC1,AC1
	MOVEM AC1,DMWHO(DDB)
	SETOM DMUSXY(DDB)		;No user-specified X-Y position for cursor
	JRST DPYM3
;DPYM2 DDWIPE DDMAP DDMAP1 DDMAP3

IFN FTDD!FTGRIN,<	;Whole page

;GETTING NEW DATA DISC CHANNEL. FIRST DESELECT AVAILABLE MSG,
;THEN ERASE CHANNEL, THEN SELECT CONSOLE TO CHANNEL.

DPYM2:	MOVE AC2,AVLBIT
	OFFSCN			;TURN OFF SCANNER CHANNEL
	ANDCAB AC2,VDPRM-DDL0(TAC1)
	MOVEM AC2,VDTMP(DDB)
	ONSCN			;TURN ON SCANNER CHANNEL
	HRLI DDB,DDWIPE
	SYSPIFF
	IDPB DDB,CLKQ
	SYSPIN
	JRST DPYM3

;HERE AT CLOCK LEVEL (CAN'T CALL QBLOCK FROM CH5) FOR DD TO ERASE NEW CHANNEL
DDWIPE:	SKIPE DDB,DPRLSF(DAT)
	JRST DPYKFS		;DPYMAKE WAS ABORTED - RET FS NOW
	PUSHJ P,GETQ
	HRRZ AC2,CURPP(DAT)
	ADDI AC2,PPENQ
	MOVEM AC2,QCOUNT(AC1)
	AOS (AC2)		;WILL HOLD UP BOTH DPLED & DPYTYP
	HRLI DAT,DDMAP
	MOVEM DAT,QWAKE(AC1)
	JRST LEERS3

;HERE AFTER ERASE IS FINISHED. NOW THAT CHANNEL IS CLEAN, WE LET HIM SEE IT.
DDMAP:
IFE FTGRIN,<
	HLRZ AC1,PRGNUM(DAT)	;DD CHANNEL NUMBER
	HRRZ TAC,PRGNUM(DAT)	;TTY LINE NUMBER
	PUSHJ P,VDBIT		;GET BIT FOR DD CHANNEL INTO AC3
	OFFSCN			;TURN OFF SCANNER CHANNEL
	IORM AC3,VDTMP(DAT)
	IORM AC3,VDPRM-DDL0(TAC)
	LDB DAT,[DDQREQ+TAC,,LSTESC] ;GET RESPONSIBLE TTY
	PUSHJ P,FINDDF		;FIND A FREE DD TO MAP/TIE NON-RESPONSIBLE DDS TO
	MOVSI AC3,-DDNUM	;PULL BACK NON-RESPONSIBLE DDS FROM OUR NEW DD
DDMAP1:	CAIN DAT,DDL0(AC3)	;IS THIS THE RESPONSIBLE TTY?
	JRST DDMAP2		;YES, SEE IF HE'S MAPPED TO AVAILABLE DD
	CAMN TAC,VDTIE(AC3)	;IS THIS DD TIED TO OUR NEWLY IN-USE DD?
	MOVEM AC1,VDTIE(AC3)	;YES, TIE HIM SOMEWHERE FREE
	LDB AC2,[POINT PUNITS,LINTAB+DDL0(AC3),35]
	CAIN AC2,(TAC)		;IS THIS GUY MAPPED TO OUR NEWLY IN-USE DD?
	DPB AC1,[POINT PUNITS,LINTAB+DDL0(AC3),35] ;MAP HIM SOMEWHERE FREE
DDMAP3:	AOBJN AC3,DDMAP1
	ONSCN			;TURN ON SCANNER CHANNEL
	SUBI TAC,DDL0
	PUSHJ P,VDOUTP		;PROPAGATE VDOUT TO ALL MAPPERS
	MOVEI DAT,DDL0(TAC)
>;IFE FTGRIN
IFN FTGRIN,<
	HRRZ DAT,PRGNUM(DAT)	;TTY LINE NUMBER
>;IFN FTGRIN
	JRST DPYTYP		;IN CASE PP XFER WAS FLUSHED

IFE FTGRIN,<
DDMAP2:	LDB AC2,[POINT PUNITS,LINTAB(DAT),35] ;GET TTY HE'S NOW MAPPED TO
	SKIPE LETAB(AC2)	;IS HE MAPPED TO A FREE TTY?
	JRST DDMAP3		;NO, LEAVE HIM ALONE
	DPB TAC,[POINT PUNITS,LINTAB(DAT),35] ;YES, MAP HIM HERE
	MOVEM TAC,VDTIE-DDL0(DAT) ;ALSO TIE HIM HERE
	JRST DDMAP3
>;IFE FTGRIN

>;IFN FTDD!FTGRIN	;Whole page
;DPYKIL DPYK00 DPYKI8 DPYKI4

; ENTER HERE AT CLOCK LEVEL WITH LINE NUMBER IN TAC TO FLUSH A DPY HEADER.
↑DPYKIL:MOVE AC1,LINTAB(TAC)
	TLNN AC1,DISLIN!DDDLIN!DMLIN
	JRST DPYKER
	SKIPE AC1,LETAB(TAC)
	SETZM LECLIN(AC1)	; CLEAR FLAG THAT SAYS CLOCK REQUEST IS IN
	SKIPE AC2,TTYTAB(TAC)	;Don't do anything unless TTYSER either is through
	TLNE AC2,KILTTY!KILDPY	;  or wants this tty made a non-display
	SKIPN AC1,LETAB(TAC)	;Get dpy header
	POPJ P,			;No dpy here after all, or don't want to touch it
	JUMPE AC2,DPYK00	;Jump if already no TTY DDB
	TLNE AC2,KILDPY		;If becoming non-display, OK even if TTY in use
	JRST DPYK00		;Skip tty-in-use test
	MOVE AC2,DEVMOD(AC2)	;Don't kill if TTY is still assigned!
	TRNE AC2,ASSCON!ASSPRG
	POPJ P,			;TTY still in use
;Keep scanner off until we have cleared LETAB now
DPYK00:	OFFSCN			;Don't let anything change till we clear LETAB
	SKIPE LEACT(AC1)	; HAS THE LINE EDITOR BEEN ACTIVE RECENTLY?
	JRST DPYKS9		; YES, WAIT SOME MORE
	SKIPN LEENQ2(AC1)	; IF HE'S REFRESHING OR HELPING,
	SKIPE LEENQ(AC1)	; OR IF HIS LINE EDITOR IS IN THE QUEUE
	JRST DPYKS7		; PLANT ANOTHER CLOCK REQUEST TO KEEP US AROUND
	SKIPN LECLK(AC1)	; IF WE HAVE CLOCK REQ FOR LINE EDITOR (DPLED),
	SKIPE DPTYCL(AC1)	; OR IF HAVE CLK REQ FOR PAGE PRINTER (DPYTYP),
	JRST DPYKS7		; THEN WAIT A LITTLE AND TRY AGAIN
	SKIPE NPPXFR(AC1)	; IF WE HAVE ANY PP XFERS QUEUED AT ALL,
	JRST DPYKS7		; THEN WAIT
	HLRZ AC2,PPCALL(AC1)	; OR IF HE HAS ANY PIECE OF PAPER QUEUED
DPYKI8:	SKIPN PPNQT(AC2)	; Any special xfers queued?
	SKIPE PPENQ(AC2)	; ANYTHING IN QUEUE?
	JRST DPYKS7		; Yes, come back later
	HRRZ AC2,PPLINK(AC2)	; PICK UP POINTER TO NEXT PIECE OF PAPER CONTROL BLOCK
	JUMPN AC2,DPYKI8	; LOOP BACK IF ANY
	JUMPL AC1,CLRLED	; If anything in line editor, send out a CLEAR char
	HRRZ DDB,AC1		; DPY HEADER ADDRESS
	HLL DDB,LINTAB(TAC)	; GET BITS INDICATING TYPE OF DISPLAY
IFN FTDD!FTGRIN,<
	PUSHJ P,PGCLR		; CLEAR ANY AND ALL PIECES OF GLASS
>;IFN FTDD!FTGRIN
	TLNN DDB,DMLIN
	JRST DPYKI3
	HRRZ TAC1,DMLEPT(DDB)	;Make sure all DM queues are empty
	HRRZ AC2,DMSPPT(DDB)
	CAIN TAC1,DMLEPT-QLINK(DDB)
	CAIE AC2,DMSPPT-QLINK(DDB)
	JRST DPYKI4		;Not empty, wait a tick and check again
	HRRZ TAC1,DMPPPT(DDB)
	HRRZ AC2,DMUSER(DDB)
	CAIN TAC1,DMPPPT-QLINK(DDB)
	CAIE AC2,DMUSER-QLINK(DDB)
	JRST DPYKI4		;Not empty, wait a tick and check again
	HRRZ TAC1,DMWHO(DDB)
	CAIN TAC1,DMWHO-QLINK(DDB)
	JRST DPYKI2		;All empty, now flush dpy header
DPYKI4:	ONSCN			;Not empty, wait a tick and check again
	PUSHJ P,DPYKI7		;Plant clock req to come back a tick later
	MOVEI DAT,(AC1)		;For STRTDM
	JRST STRTDM		;Start tty (eg, PJOB cmd doesn't start created tty)
;DMCLRU CLKFLS CLKFL1 CLKFL2

;Routine to flush clock request that would have cleared user run flag for DM prog.
;Clobbers only TAC.  Here from DMUPG and DPYRST, either in CH7 or at UUO level,
;after calling CHASEM or DDWAIT to make sure no user display program still going.
DMCLRU:	SETZM UCOUNT(DDB)	;Don't let user's run flag be cleared later!
	MOVEI TAC,(DDB)		;Dpy header is datum of clock request
	HRLI TAC,DMUCLK		;Flush this DM's clock request for DMUCLK, if any
	;Fall into CLKFLS
;Routine to remove requests from DPYSER's clock queue.  Searches queue for
;request(s) matching that in TAC and changes each's dispatch address to
;CPOPJ.  It is the callers responsibility to make sure no similar clock
;request is planted while this routine is working.
CLKFLS:	SKIPN @CLKQ		;ANY REQUESTS IN THE CLK QUEUE ?
	POPJ P,			;NO. SEE HOW LITTLE TIME WE HAVE WASTED !!
	PUSH P,AC1		;SAVE AN AC
	HRRZ AC1,CLKQ		;GET PTR. TO CURRENT END OF QUEUE.
CLKFL1:	CAME TAC,(AC1)		;IS THIS THE CLOCK REQUEST WE WANT TO FLUSH?
	JRST CLKFL2		;NO
	HRLI TAC,CPOPJ		;TURN DISPATCH ADDRESS INTO NO-OP ROUTINE
	EXCH TAC,(AC1)		;CHANGE CLOCK REQUEST TO NO-OP
CLKFL2:	SUBI AC1,1		;NOW GET PTR. TO NEXT LOWER REQUEST IN CLOCK QUEUE
	CAIL AC1,CLKQUE		;ARE WE AT BOTTOM OF QUEUE ?
	JRST CLKFL1		;NO. BACK FOR MORE.
	POP P,AC1		;RESTORE
	POPJ P,
;SPIONJ DPYKI2 DPYKI3 DPYKL1 DPNONO DPNOT4

SPIONJ:	SYSPIN
	JRST SCNONJ		;Now turn on scanner channel and return

DPYKI2:	PUSH P,TAC
	PUSHJ P,DMCLRU		;Clear UCOUNT and flush our clk req for DMUCLK
	POP P,TAC
DPYKI3:	SYSPIFF
	SKIPE AC2,TTYTAB(TAC)	;Don't do anything unless TTYSER either is through
	TLNE AC2,KILTTY!KILDPY	;  or wants this tty made a non-display
	SKIPN LETAB(TAC)	;Any dpy header?
	JRST SPIONJ		;No dpy here after all, or don't want to touch it
	SETZM LETAB(TAC)
IFN FTLCLDM,<
	MOVE TAC1,TAC		;Sigh, following byte ptrs want line number in LINE
	MOVSI AC2,NEHTFL	;Zero RH byte, plus hold-toggle flag
	DPB AC2,NEMBPT		;Zero the no-edit quoting mode
	DPB AC2,NESBPT		;Zero no-edit state flags
	SKIPGE EDITKY(TAC)	;Skip if not a no-edit keyboard
	ANDCAM AC2,EDITKY(TAC)	;Turn off hold-toggle mode
>;IFN FTLCLDM
IFE FTF2,<
	JUMPGE DDB,DPYKL1	; JUMP UNLESS III
	SETZM RSTTBL-DPYL0(TAC)
	SETZM STPTBL-DPYL0(TAC)
	SETZM STRTBL-DPYL0(TAC)
>;IFE FTF2
DPYKL1:	SYSPIN
	PUSH P,DDB
	SKIPN DDB,TTYTAB(TAC)
	JRST DPNOT4		;No DDB (shouldn't happen)
	TRNN DDB,-1		;Is there really a DDB pointer?
	JRST DPNONO		;No, this ain't supposed to happen!!
	TLNE DDB,KILDPY		;Don't flush DDB if just want to become non-display
	JRST DPNODP		;Becoming non-display
	PUSH P,IOS
	PUSH P,TAC
	MOVE IOS,DEVIOS(DDB)
	MOVE TAC1,TAC		;Line number
	HLL TAC1,LINTAB(TAC1)
	PUSHJ P,TTYKL5		;Flush TTY DDB now and TURN ON SCANNER
	POP P,TAC
	POP P,IOS
	JRST DPNOT3

DPNONO:	PUSHACS
	HRRZ TAC,TAC
	PUSH P,TAC
	PUSHJ P,DISGST		;PRINT TIME OF NEW MESSAGE ON CTY
	PUSHJ P,DISERR
	[ASCIZ/NO TTY DDB AT DPYKIL BUT TTYTAB NON-ZERO FOR TTY/]
	DISARG LOC,<-1(P)>
	[ASCIZ/
/]
	-1
	SUB P,[1,,1]
	PUSHJ P,DISFLU
	POPACS
	PUSHJ P,WDDTCA
	SETZM TTYTAB(TAC)
DPNOT4:	ONSCN
	JRST DPNOT3
;⊗ TPTINT TPTIN2 TPTIN3 DPKSTR DPKST2 DPKRLP DPKROL DPNODP DPNOT3 DPYKML

;Call with TTY line number in TAC (sorry) and DDB in DDB to interrupt
;job on TTY and controlling job if PTY for TTY status change.
;Clobbers AC1.

↑TPTINT:MOVSI AC1,INTTTC	;Interrupt on Terminal-Type-Change
	PUSH P,J
IFE FTIP,<
	CAIL TAC,PTYL0		;IS IT A PTY?
	SKIPN J,PTYJOB-PTYL0(TAC)
	JRST TPTIN2		;NOT A PTY OR NO CONTROLLING JOB
>;IFE FTIP
IFN FTIP,<
	CAIGE TAC,PTYL0			;Is it a PTY?
	 JRST TPTIN2			;No
	SKIPE J,PTYIMP-PTYL0(TAC)	;Is it an IMP PTY?
	 PUSHJ P,TPTIMP			;Yes, go tell IMPSER
	SKIPN J,PTYJOB-PTYL0(TAC)	;Is there a controlling job?
	 JRST TPTIN2			;No
>;IFN FTIP
	TDNN AC1,JBTIEN(J)
	JRST TPTIN2
	IORM AC1,JBTIRQ(J)
	TDNE AC1,JBTMSK(J)	;ANY BIT MASKED ON?
	SETOM INTREQ		;YES, RUN INTERRUPTS
TPTIN2:	PUSH P,DDB
	SKIPN DDB,TTYTAB(TAC)
	JRST TPTIN3		;NO DDB
	LDB J,PJOBN		;Get job number of TTY user
	JUMPE J,TPTIN3
	TDNN AC1,JBTIEN(J)	;Is the user enabled for this interrupt?
	JRST TPTIN3		;No
	IORM AC1,JBTIRQ(J)	;Yes, request the interrupt
	TDNE AC1,JBTMSK(J)	;ANY BIT MASKED ON?
	SETOM INTREQ		;YES, RUN INTERRUPTS
TPTIN3:	POP P,DDB
	JRST POPJJ

;Output tty-no-dm string for this type of display.  Call with line nbr in TAC.
;Skips unless no DDB for this tty or isn't a DM.
;Enter at DPKSTR from FIXITY in IMPSER.  Enter at DPKST2 from DPKROL below.
↑DPKSTR:MOVE AC1,LINTAB(TAC)	;Don't do this unless a display
	TLNE AC1,DMLIN		;skip if not a display
DPKST2:	SKIPN DDB,TTYTAB(TAC)	;Should still be a DDB here...
	POPJ P,
	MOVSI TAC1,TTYFIL	;With TTY NO DM you get free TTY NO FILL!
	ANDCAM TAC1,LINTAB(TAC)
	SKIPN AC2,DPYDES(TAC)	;Get pointer to Display Descriptor Table
	MOVE AC2,DPYDFT		;Whaddayamean there isn't one??  Use default.
	HRRZ AC1,DPCNDM(AC2)	;Get address of dpy-specific TTY NO DM string
	HRLI AC1,441000		;Make 8-bit byte pointer
	HLRZ AC2,DPCNDM(AC2)	;Get byte count for TTY NO DM string
	SOJL AC2,CPOPJ1		;Jump if null string
DPKRLP:	ILDB CHR,AC1		;Get next 8-bit char
	PUSHJ P,PUTCRS		;Put char directly into output buffer
	SOJGE AC2,DPKRLP	;Jump back if more to do
	JRST CPOPJ1

;Finish TTY NO DM cmd, outputting spcl string for this display type.
DPKROL:	PUSH P,TAC		;Save line number
	PUSHJ P,DPKST2		;send tty no dm string for this dpy
	 JRST TPOPJ		;no DDB
	PUSHJ P,INLMES
	ASCIZ/
*** Non-display service ***
/
	PUSHJ P,TYPGO		;Now start output
	POP P,TAC		;Line nbr, restore and use to restore LINTAB
	POPJ P,

;Here if we want to make this display (DM) into a non-display. Scanner is off.
DPNODP:	MOVSI TAC1,DMLIN
	ANDCAM TAC1,LINTAB(TAC)	;No longer a display now
	PUSHJ P,TPTINT		;TTY and PTY status interrupt
	ONSCN
	MOVE DDB,(P)		;Get back dpy hdr address and display-type bit
	TLNE DDB,DMLIN
	PUSHJ P,DPKROL		;Output TTY NO DM string for this terminal
DPNOT3:	POP P,DDB
	MOVSI TAC1,KILDPY
	ANDCAM TAC1,TTYTAB(TAC)	;All done making this a non-display
	HRRZ AC2,DDB		;DPY HEADER ADDRESS
	MOVE J,JOBNM1
DPYKML:	CAIN AC2,@DPYMAP(J)
	SETZM DPYMAP(J)		;CLEAR GUY MAPPED TO US BY PROGRAM
	SOJG J,DPYKML

	;FALL THRU TO NEXT PAGE
;DPYK12 DPYK11 DPYKFS DPYKF1 DPYKF2 DPYKF3

	PUSHJ P,DPYKFS		;GIVE ALL THE CORE BACK
IFE FTF2,<
	JUMPL DDB,DPYK11	;JUST DIDDLE SELECT FOR III
>;IFE FTF2
IFN FTDD!FTGRIN,<
	TLNN DDB,DDDLIN
>;IFN FTDD!FTGRIN
	POPJ P,			;AGAIN DM'S SEEM TOO EASY
IFN FTDD!FTGRIN,<
	OFFSCN
	MOVSI AC3,-DDNUM	;SEE IF WE WERE HOME DD FOR SOME DD
	MOVEI AC2,0		;NEW VALUE OF HOME FOR ANY SUCH DDS
DPYK12:	LDB AC1,[HOMEPT+DDL0(AC3)]
	CAIN AC1,(TAC)		;WERE WE HIS HOME?
	DPB AC2,[HOMEPT+DDL0(AC3)] ;YES, BUT WE AREN'T ANY MORE
	AOBJN AC3,DPYK12
	ONSCN
>;IFN FTDD!FTGRIN
IFN FTGRIN,<
	POPJ P,
>;IFN FTGRIN
IFE FTF2,<
	SUBI TAC,DDL0		;MAKE IT DD NUMBER, ARG FOR VDOUTP
	HLRZ AC1,PRGNUM(DDB)	;DD CHANNEL NUMBER
	PUSHJ P,VDBIT		;MAKE A MASK BIT FOR THIS CHANNEL
	ANDCAM AC3,VDPRM(TAC)	;REMOVE DD LINE'S CHANNEL FROM HIS MAP
	MOVE AC3,AVLBIT
	IORM AC3,VDPRM(TAC)	;ADD IN THE AVAILABLE CHANNEL
	PUSHJ P,VDOUTP		;MAKE GUY GOING AVAILABLE SEE AVAILABLE MESSAGE
	MOVSI TAC,DTTUSR-DTTL0+DDL0(TAC) ;ARGUMENT FOR DDREL (OLD USE CODE)
	HLR TAC,PRGNUM(DDB)	;DD CHANNEL NUMBER
	JRST DDREL		;RELEASE THE DD CHANNEL
>;IFE FTF2

IFE FTF2,<
DPYK11:	MOVNI TAC,-DPYL0(TAC)	; NEGATIVE OF III NUMBER
	MOVSI AC1,400000	; PUT A BIT IN THE CONSOLE SELECT POSITION
	LSH AC1,-=12(TAC)	; PUT IT IN THE RESET PART FIRST
	ANDCAM AC1,DPYAVL+1	; DON'T RESET US
	ANDCAM AC1,WHOSEL	; DON'T RESET US FOR WHOLINE EITHER
	LSH AC1,=12		; PUT IT IN THE SELECT POSITION
	IORM AC1,DPYAVL+1	; SELECT THIS CONSOLE
	IORM AC1,WHOSEL		; SELECT THIS CONSOLE FOR SYS WHO LINE
	POPJ P,			; BYE NOW.
>;IFE FTF2

DPYKFS:	MOVNI AC2,3
	MOVEI AC3,DPYFS
	PUSHJ P,SFSREL		;GIVE BACK SPARE TEXT BLOCKS
	HLRZ DAT,PPCALL(DDB)
	JUMPE DAT,DPYKF2	;NO PAGE PRINTER
DPYKF1:	MOVE AC1,FBLKPT(DAT)
	PUSHJ P,FREEL		;RELEASE TEXT BLOCKS
	HRRZ AC1,PTB(DAT)
	JUMPE AC1,.+2
	PUSHJ P,FSGIVE		;& LINE POINTER TABLE
	MOVE AC1,DAT
	HRRZ DAT,PPLINK(DAT)	;GET POINTER TO NEXT P. OF P.
	PUSHJ P,UGIVFS		;BECAUSE THIS ONE'S GOING AWAY
	JUMPN DAT,DPYKF1	;KEEP GOING IF MORE
DPYKF2:	SKIPE AC1,DMFS(DDB)
	PUSHJ P,FSGIVE		;Return any special FS used by DM
	MOVEI AC2,(DDB)		;Get dpy hdr where CLRNED wants it
	OFFSCN
	PUSH P,TAC		;Preserve line number (DPYKILL) or whatever
	PUSHJ P,CLRNED		;Release variable char macro blocks (does ONSCN)
	POP P,TAC
DPYKF3:	MOVEI AC1,(DDB)
	JRST UGIVFS		;NOW RETURN HEADER
;DPYKS7 DPYKS9 DPYKI9 DPYK9 DPYKI7 DPYKI6 SCLOCK SCLOC2 CLRLED DPYKER
; WE GET HERE TO PLANT ANOTHER CLOCK REQUEST TO COME BACK
; LATER TO TRY AND KILL THE DAMN THING.

DPYKS7:	ONSCN
	JRST DPYKI7

DPYKS9:	ONSCN
DPYKI9:	SETZM LEACT(AC1)	; CLEAR THE ACTIVE FLAG
↑DPYK9:	SKIPN AC3,DDQDLY	;Get delay in case giving someone channel from queue
	MOVEI AC3,=15*=60	;Normally wait 15 seconds before killing display
	HRRZ AC2,PRGNUM(AC1)	;Get line number
	MOVE AC2,TTYTAB(AC2)	;See if we really just want to make into a non-dpy
	TLNN AC2,KILDPY		;Only wait one tick to try again to make non-DM
	TLOA AC3,$DPYKIL
↑DPYKI7:MOVE AC3,[$DPYKIL,,1]	;Wait one tick and check again
	LSH TAC,=12		; SHIFT LINE NUMBER OVER TO DATA POSITION
	ADD TAC,AC3		; HAVE US COME BACK HERE IN 1 TICK
	SETO AC2,		; SET FLAG SAYING THERE IS A CLOCK REQUEST IN
	EXCH AC2,LECLIN(AC1)
	JUMPL AC2,DPYKI6	; IF THERE ALREADY IS A CLOCK REQUEST IN, DON'T BOTHER TO SET ANOTHER
	CLKENQ(TAC)		;Plant clk req
	POPJ P,

;Here we try to speed up TTY NO DM, in case there was already a clock
;request in (for say 15 secs from now) to kill the dpy hdr, for instance if
;the user had just logged out.  Note that if we're from DPYKIL having to
;wait, we won't get here because LECLIN will have been zero.
DPYKI6:	ANDI AC3,7777		;Just clock delay we want
	CAIE AC3,1		;Want to wait one tick?
	POPJ P,			;No, not here from TTYNDM
	PUSHJ P,SCLOCK		;Search clock queue for request matching TAC
	 HRRM TAC,(AC3)		;Stuff new (shorter time) into clk req in queue
	POPJ P,

;Routine to search clock queue (not DPYSER's, but CLKSER's own) for clock
;request matching that in TAC (not counting the tick count in low 12 bits).
;Takes direct return with pointer to clock req in AC3 if found.  Otherwise skips.
;Clobbers AC2,AC3 only.
SCLOCK:	HRRZ AC3,CLOCKP		;GET END OF LIST
SCLOC2:	CAIG AC3,CIPWT-1	;END YET?
	JRST CPOPJ1		;YES, take failure return
	MOVE AC2,(AC3)		;Get clk req from queue
	XOR AC2,TAC		;Compare with clk req of interest
	TRZ AC2,7777		;Ignore time portion of req
	JUMPE AC2,CPOPJ		;Jump if matches
	SOJA AC3,SCLOC2

;Here with scanner PI channel off.
CLRLED:	SKIPE DDB,TTYTAB(TAC)	;Set up tty ddb
	TRNN DDB,-1
	JRST SCNONJ		;How can we not have a ddb?
	MOVE IOS,DEVIOS(DDB)
	PUSHJ P,STLNAC		;Set up LINE
	MOVEI CHR,10044		;Send a CLEAR character
	SETZB UCHN,DSER		; with no bits
	PUSHJ P,KBDEDP		;Pretend user typed it
	JRST SCNONJ

; THIS ROUTINE PRINTS AN ERROR MESSAGE WHEN THE GIVEN
; LINE NUMBER IS NOT A DISPLAY

DPYKER:	PUSH P,TAC		; SAVE THE ILL NUMBER
	PUSHJ P,DISUSR		;PRINT TIME OF NEW MESSAGE ON CTY
	 SIXBIT /DPYKIL/
	PUSHJ P,DISERR		; GIVE OUR ERROR MESSAGE
	[ASCIZ /NON-DISPLAY LINE NUMBER AT DPYKILL - /]
	DISARG OCT,<-1(P)>
	[ASCIZ /
/]
	-1
	POP P,TAC
	POPJ P,
;DPYINT NOSTOP L6 L5 L3 DPYXIT

IFE FTF2,<	;Whole page

;HERE ARE THE INTERRUPT ROUTINES FOR RUNNING THE DP.

↑DPYINT:

BEGIN DPYINT

DPCONB←←40	;THE CONTINUE BIT FOR THE DP
DPNULL←←0
DPNXM←←2000	;THE NON-EX MEM BIT
DPINT←←4000	;INTERRUPT REQUEST
DPSTOP←←200	;SET NOT RUNNING
DPCHK←←400	;ERROR CHECK FLAG

	CONSZ DPY,7
	JRST L10
	SETZM DSFLAG		;IF HERE FROM CLOCK, FLUSH CLOCK FLAG
IFKL10,<SKIPL PFPARF
	CONO PI,20020		;AND CLEAR INITIATED INT IF NOT GOING TO PARSER
>;IFKL10
L10:

;	CONSO DPY,400000	;IS IT REALLY STOPPED ?
;	JRST DPYXIT		;NO. 
	EXCH TAC,DRUNCT		;GET NO. OF DPY WHICH HAS BEEN ON.
	JUMPL TAC,L1A
	SKIPN STPTBL(TAC)	;STOP HIM HERE ONLY IF HE HAS A STOP TABLE
	JRST NOSTOP
	MOVEM TAC1,@SELTBL(TAC)
IFN 0,<
	MOVS TAC1,STPTBL(TAC)
	SETZM (TAC1)		;Clear the saved PC
REJMS:
>;IFN 0
	DATAO DPY,STPTBL(TAC)	;MAKE DP RECORD ITS STATE IN RIGHT DPY HDR AT PRGSTP
IFN 0,<
	ROT 44			;I don't know, just wait a little
	SKIPN (TAC1)		;Did the DP store anything?
	JRST REJMS		;No!  Tell it again
>;IFN 0
	CONI DPY,TAC1		;SAVE CURRENT SELECTION FOR NEXT TIME
	HRRI TAC1,DISSEL
	EXCH TAC1,@SELTBL(TAC)
NOSTOP:	CONSZ DPY,DPNXM!DPCHK	;HIT A NON-EX MEM OR ERROR CHECK?
	JRST DPERR		;YES, PROCESS IT
L6:	SOJL TAC,L1		;NEXT PRGM TO RUN. (6 PRGMS ALWAYS ARE RUNNING)
L5:
;	CONSO DPY,400000	;MAKE SURE HE FINISHED STOPPING
;	JRST L5
	SKIPE RSTTBL(TAC)	;DOES HE WANT TO START FROM THE FRONT ?
	JRST L2			;YES.
	SKIPN STRTBL(TAC)	;IS THERE A PROGRAM THERE?
	JRST L7
	DATAO DPY,STRTBL(TAC)	;NO.  START HIM AT NORMAL PLACE TO RESUME
L3:	EXCH TAC,DRUNCT		;PUT THINGS BACK.
	ROT 44
	CONO DPY,DPCONB+DPYCHN+740000+1000	;START DP AND CLEAR MASKS.
DPYXIT:

	MTRCOF (CH3,P2NOCK)

	JRST 12,@DPYCHL		;RETURN TO WHOMEVER.

>;IFE FTF2	;Whole page
;DPERR DPENNX NOADDR NOMBSY NODPLK L8 L9

IFE FTF2,<	;Whole page

;HERE WE HAVE AN ERROR - - PRINT A MESSAGE AND CHECK THE SYSTEM!
DPERR:	EXCH P,APRPDL		;GET A STACK
	PUSHACS			;GET US SOME AC'S
	MOVEI PID,P1PID
	MOVEM TAC,SAVTAC	;SAVE DP #
	CONI DPY,DPCNI		;GET SOME BITS
	PUSHJ P,DISUSR		;PRINT TIME OF NEW MESSAGE ON CTY
	 SIXBIT /DPERR/
	PUSHJ P,DISERR
	[ASCIZ/DP ERROR.  DPY# = /]
	DISARG LOC,SAVTAC
	[ASCIZ/  CONI BITS = /]
	DISARG OCH,DPCNI
	-1
	MOVE AC3,DPCNI		;See if we got a NXM
	TRNN AC3,DPNXM		;NXM bit on?
	JRST DPENNX		;No
	PUSHJ P,DISMES
	 ASCIZ/  NXM  /
DPENNX:	MOVE AC3,SAVTAC
	SKIPN AC3,STPTBL(AC3)
	JRST NOADDR
	HLRZS AC3
	HLRZ AC3,(AC3)		;GET MA
	PUSHJ P,DISERR
	[ASCIZ/    MA = /]
	DISARG LOC,AC3
	-1
NOADDR:	PUSHJ P,DISMES
	 ASCIZ/   MPX CONI = /
	CONI MPX,TAC		;Get MPX bits to see if it is losing
	PUSH P,TAC
	PUSHJ P,DISLOC		;Print 'em
	POP P,TAC
	TRNN TAC,MBUSY		;MPX maybe have BUSY stuck on?
	JRST NOMBSY
	PUSHJ P,DISMES
	 ASCIZ/  BUSY/
NOMBSY:	PUSHJ P,DISCRL
	PUSHJ P,CHKNOW		;CHECK SYSTEM FOR CLOBBERAGE
	MOVE TAC,DPCNI
	TRNN TAC,DPNXM		;Pause in DDT if DP NXM
	JRST NODNXM		;No NXM
	PUSHJ P,DISFLUSH	;FORCE OUT THE REST
	PUSHJ P,WDDTCALL	;AND CALL DDT
	JRST NODPLK

NODNXM:	DEBCHECK(NOPOPACS)	;CALL DDT IF HAVE SEEN TOO MANY OF THESE
NODPLK:	PUSHJ P,ZSHAD		;ZERO SHADOW ACS, IN CASE III GETS THERE
	 JFCL			;May skip
	MOVE TAC,DPCNI
	TRNE TAC,DPNXM		;Did we see a NXM?
	CONO MPX,20000		;Yes, reset the MPX for good measure
	MOVEI TAC,DPYNUM-1	;RESTART ALL DISPLAYS
L8:	SKIPN DDB,LETAB+DPYL0(TAC)
	JRST L9			;IF NONE THERE, LOOP
	HRLI AC1,PSELB(DDB)	;ARRANGE TO RESTART AT TOP AGAIN
	HRRI AC1,DISJMP
	MOVEM AC1,RSTTBL(TAC)
	MOVEM AC1,PRGSTP(DDB)	;Clobber old continue PC to really restart
				; at beginning, in case DATAO DPY,STPTBL loses!
L9:	SOJGE TAC,L8		;GET THEM ALL!
	POPACS			;GET BACK AC'S
	EXCH P,APRPDL		;AND WHATEVER WAS IN P
	JRST L6			;AND DO NEXT GUY

>;IFE FTF2	;Whole page
;L2 L1 L1A L4 L7

IFE FTF2,<	;Whole page

; DP INTERRUPT CODE - RESTART PROGRAM, LOOP AROUND OF NEXT DPY, STOP DP, SET AVAILABLE MESSAGE

L2:	DATAO DPY,RSTTBL(TAC)	;START GUY AT BEGINNING OF HIS PRGM.
	SETZM RSTTBL(TAC)	;...THIS TIME ONLY.
	JRST L3

L4:	CONO DPY,DPNULL		;SHUT DOWN THE DP.
	EXCH TAC,DRUNCT
	JRST DPYXIT

L7:	SKIPE DPYARN		;HAS THE 'CONSOLE AVAILABLE' MESSAGE GONE OUT YET?
	JRST L6			;YES
	SETOM DPYARN		;NO, IT WILL.
	DATAO DPY,[DPYAVL,,DISJMP]
	JRST L3			;GO START UP DP AND LEAVE

L1:	DATAO DPY,[COMIII,,DISJMP]	;HERE IF DRUNCT WAS 0, PUT OUT WHO LINES
	JRST L3

L1A:	AOJN TAC,L1C		;HERE IF DRUNCT WAS NEG, JUMP IF WAS -2
	LDB TAC,[POINT 6,DPYHLD,5]	;WAS -1, HOLDING MSG NOT YET OUT
	JUMPN TAC,L1B		;NEED TO RUN HOLDING MESSAGE
L1C:	MOVEI TAC,DPYNUM-1	;WE'VE RUN `EM ALL.
	SETZM DPYARN		;NOTE THAT THEY HAVE ALL BEEN RUN
	AOSE DSFLAG		;HAS CLOCK TICKED ?
	AOJA TAC,L4		;NO. IT'S NOT YET TIME TO START OVER.
	JRST L5

L1B:	MOVNI TAC,2		;DRUNCT ← -2
	DATAO DPY,[DPYHLD,,DISJMP]
	JRST L3

BEND DPYINT

>;IFE FTF2	;Whole page
;PPINIT PPI1 PPI3 -- PAGE PRINTER STUFF

COMMENT ⊗	THIS IS THE ABODE OF THE FEARSOME PAGE PRINTER.  IT ALLOWS
EACH LUCKY USER (IF HE IS OBEDIENT) TO HAVE UP TO 16 PIECES OF PAPER (OR
REASONABLE FACSIMILE THEREOF), ON ANY OF WHICH HE CAN TYPE AND DRAW IN
DIVERSE WAYS, AND WHICH CAN BE ROLLED BACKWARD AND FORWARD AND DISPLAYED
SEPARATELY OR IN ARBITRARY COMBINATION WITH OTHER DISPLAYS.
    EACH PIECE OF PAPER CONSISTS OF A LINKED SET OF BLKS FROM FREE STORAGE
AND ONE CONTROL BLOCK, ALSO FROM FREE STORAGE. THE CONTROL BLOCK IS LINKED
TO THE PROGRAM HEADER AND TO THE CONTROL BLOCKS FOR ANY OTHER PIECES OF
PAPER BELONGING TO THE SAME PROGRAM. ⊗

; WE GET HERE MOSTLY IF A REQUEST FOR FREE STORAGE FOR THE PAGE PRINTER FAILS
PPI3:	HRRZ AC1,CBLKPT(DAT)	; RETURN FIRST PIECE OF TEXT
	PUSHJ P,FSGIVE
PPI1:	HRRZ AC1,DAT		; AND RELEASE CONTROL BLOCK ITSELF
	PUSHJ P,FSGIVE		; TAKE ERROR RETURN FROM PPINIT
	POPJ P,			; PLEASE DON'T OPTIMIZE!

;INITIALIZE A PAGE PRINTER WITH PIECE OF PAPER 0.
;CALL WITH MAIN DD CHANNEL IN TAC, OR IF NOT DD, WITH LINE BITS IN TAC RH (NOTE RH)
;Also, dpy hdr address must be in DDB.
PPINIT:	PUSHJ P,PPFSGE		;GET A BLOCK OF FREE STORAGE.
	 POPJ P,		; NO FREE STORAGE, GIVE ERROR RETURN
	HRR AC3,AC2		;MAKE BLT POINTER.
	HRRZ DAT,AC2
	HRLI AC3,PPMODL
	BLT AC3,BLKSIZ-1(AC2)	;INIT THE CONTROL BLK BY COPYING PROTOTYPE INTO IT
	PUSHJ P,PPFSGE		;GET A FREE STORAGE BLOCK FOR FIRST PART OF PRGM
	 JRST PPI1		; NO FS, RELEASE PREVIOUS BLKS, TAKE ERROR RETURN
	MOVEM AC2,CBLKPT(DAT)	;MAKE IT CURRENT BLOCK...
	MOVEM AC2,FBLKPT(DAT)	;.. AND FIRST BLOCK IN CORE...
	MOVEM AC2,TBLKPT(DAT)	;... AND TOP BLK BEING DISPLAYED.
	HRRM AC2,PPTR1(DAT)	;MAKE BYTE POINTER FOR TYPING POINT
	SOS PPTR1(DAT)		; ONE BEFORE BOTTOM OF BLOCK.
	HRLM AC2,TPJMP(DAT)	;FIX UP JMP TO PRGM IN CONTROL BLOCK
	HRLI AC3,TPJMP+1(DAT)	;RETURN ADDR FROM PRGM TO CONTROL BLK
	HRRI AC3,DISJMP
	MOVEM AC3,(AC2)		;PUT RETURN JMP IN FIRST WORD OF PRGM.
	HRLZM DAT,PPLINK(AC2)	;BACKWARD LINK OF PRGM POINTS TO CONTROL BLOCK
	SETZM PPLINK(DAT)	;ONLY ONE CONTROL BLOCK.
	MOVE AC3,[DDDLIN,,POSLDD]
	TRNE TAC,DISLIN
	MOVE AC3,[DISLIN,,POSLII]
	TRNE TAC,DMLIN
	MOVE AC3,[DMLIN,,POSLDM]
	MOVEM AC3,PPDPY(DAT)	; STORE BITS FOR DISPLAY TYPE AND POSLIN SUBROUTINE
;PPINI2 PPXFT

	MOVEI AC3,LPFS		; GET SOME FREE STORAGE FOR THE
	PUSHJ P,SFSGET		; LINE POINTER TABLE
	 JRST PPI3
	MOVEM AC1,PTB(DAT)	; SAVE ADDRESS OF BEGINNING OF BLOCK
	ADDI AC1,=20		; BUMP ADDRESS TO VISIBLE SCREEN PART
	HRRM AC1,PTRB(DAT)
	MOVE AC2,PPTR1(DAT)	; INITIALIZE FIRST WORD OF POINTER TABLE
	ADDI AC1,YLINE-1	; Starting on 4th line of screen
	MOVEM AC2,(AC1)		; TO POINT TO FIRST OF TEXT
	MOVEM AC2,1(AC1)	; SAME FOR DD
	TRNE TAC,DISLIN
	JRST PPFXT		; DONE FOR III
	MOVEI AC1,YLINE		; Start on line 4
	MOVEM AC1,VPOS(DAT)
	MOVEM AC1,LLW(DAT)
	MOVEM AC1,GLW(DAT)
	MOVEI AC1,NLSDD		; DEFAULT NUMBER OF LINES/GLITCH FOR DD
	TRNE TAC,DMLIN
	MOVEI AC1,NLSDM		; DEFAULT L/G FOR DM
	MOVEM AC1,DEL(DAT)
	MOVEM AC1,DELCNT(DAT)
IFE FTF2,<	;GRINNELL USES DMNORM JUST LIKE DM DOES
	MOVEI AC1,NGSDD		; DEFAULT NUMBER OF GLITCHES/SCREEN FOR DD
	TRNE TAC,DMLIN
>;IFE FTF2
	PUSHJ P,DMNORM		; GET DEFAULT GLITCHES/SCREEN FOR DM INTO AC1
	MOVEM AC1,PGSIZ(DAT)	; STORE GLITCHES/SCREEN
	SETZM DDSAV(DAT)	; CLEAR EXTRA SAVED WORDS
IFN FTDD,<
	MOVE AC1,[CW 1,46,2,0,3,2]
	DPB TAC,[POINT 8,AC1,15]
>;IFN FTDD
IFN FTGRIN,<
	MOVE AC1,DCHWID(DDB)	;Get char width in pixels
	DPB AC1,[POINT 10,GRCW4(DAT),15] ;Store X pos in LEA command
	DPB AC1,[POINT 10,GRCW3(DAT),15] ;Store delta-X per char
	MOVE AC1,GRCHAN(TAC)	;Get LDC and LSM commands to select right screen
>;IFN FTGRIN
	MOVEM AC1,DDCW(DAT)
	MOVE AC2,DPYHGT(DDB)	;Get display height
	MOVEM AC2,PPSHGT(DAT)	;Store in PP
	MOVE AC2,DPYWID(DDB)	;Get display width
	MOVEM AC2,LNLNGT(DAT)	;Store as PP line length
	MOVNM AC2,DPHPOS(DAT)	; INITIALIZE THE HORIZONTAL POSITION COUNTER
	MOVE AC1,[LVW -777,YPDD,I,A,2,2]
	TRNE TAC,DMLIN
	MOVE AC1,[LVW -777,YPDM,I,A,2,2]
	MOVEM AC1,PPOSV(DAT)
	LDB AC1,[POINT 11,AC1,21] ;INITIAL Y POSTION IS GUARANTEED POSITIVE!!!
	HRRM AC1,PPYVAL(DAT)	;INITIALIZE 18-BIT VALUE OF Y POSITION
	SETZM TPJMP+1(DAT)
	SETZM TPJMP+2(DAT)
IFN FTDD,<
	MOVE AC1,[CW 3,2,4,0,5,0]
	MOVEM AC1,DDCW2(DAT)
>;IFN FTDD
PPFXT:	MOVE AC1,DAT
	JRST CPOPJ1
;PPFSGE CGETFS UGFS2 UGETFS CGIVFS UGIVFS GETQ UGETF2 UGETF1 UGETF3 UGETF4
; FREE STORAGE HANDLER FOR PAGE PRINTER

PPFSGE:	MOVE AC2,AC1
	MOVEI AC3,PPFS
	AOS (P)
	PUSHJ P,SFSGET
	 SOS (P)
	EXCH AC2,AC1
	POPJ P,

;;UGETFS IS FOR GETTING FREE STG. AT UUO LEVEL (INCLUDING SPW LEVEL)
; CGETFS AND CGIVFS ARE ONLY CALLED BY UPG, (AT UUO LEVEL OR SPW LEVEL) TO COUNT THE
; TOTAL NUMBER OF BLOCKS IN A USERS COMBINED DISPLAY PROGRAMS
; CGETFS EXPECTS THE DPY HEADER ADDRESS IN DDB

;CGIVFS must use wait list for III FS, lest III still running
;
;On F2, if we are called from UUO level, we would rather wait for free storage
;than take from the spares list.  This is flagged in DPYFS (CACDAT).
;
;In either case, we never want to go to CLKWAT from user mode.
CGETFS:	AOSA BLKTOT(DDB)
UGFS2:	PUSHJ P,CLKWAT		;WAIT FOR SOME FS TO APPEAR.
↑UGETFS:MOVEI AC3,DPYFS		;;GET A BLOCK OF FREE STG
	PUSHJ P,SFSGET
	  SKIPE AC1,SPWUUF	;WE ARE AT CLOCK LEVEL AND THERE'S NO FREE STG.
	POPJ P,
	SKIPN AC1,INTACT	;AT USER INTERRUPT LEVEL
	CONSZ PI,77000		;OR REGULAR INTERRUPT LEVEL, BUT NOT CLOCK LEVEL?
	 JRST UGETF4		; TAKE FAILURE RETURN
	CONSZ PI,77400		;USER MODE?
	 JRST UGFS2		; NO, WAIT AT CLOCK LEVEL
	MOVEI AC3,BLKSIZ	;GET STANDARD SIZE BLOCK
	JRST UGETF1		;THIS ONE WILL WAIT!

; ROUTINE TO RELEASE FREE STORAGE BLOCKS
; CGIVFS EXPECTS THE DPY BLOCK HEADER ADDRESS IN DDB

CGIVFS:
IFN FTF2,<
	SOS BLKTOT(DDB)		;DECR. COUNT OF USED BLOCKS...
	PUSHJ P,FSGIVE		; DON'T OPTIMISE
	POPJ P,
>;IFN FTF2
IFE FTF2,<
	SOS BLKTOT(DDB)		;DECR. COUNT OF USED BLOCKS...
>;IFE FTF2
↑UGIVFS:SYSPIFF
	MOVE AC2,FSWT2H		;FREE THE BLOCK IN AC1.
	HRRZM AC1,FSWT2H
	HRRM AC2,PPLINK(AC1)
	SYSPIN
	AOS FSW2C
	POPJ P,

;GET A DD Q BLOCK
↑GETQ:	PUSH P,AC3
	MOVE AC3,[SETZ DDFS]	;NO SKIP
	PUSHJ P,SFSGET
	POP P,AC3
	POPJ P,

; UGETF1 IS LIKE ALL THE OTHERS EXCEPT THAT IT GOES DIRECTLY TO THE
; STANDARD F.S. ROUTINES, RATHER THAN USING THE SPARE LIST.  IF WE
; FAIL TO GET FREE STORAGE AND WE CAN'T WAIT (SPACEWAR, USER INT.),
; THEN RETURN -1. (MAYBE THE USER WON'T MISS ONE TIC OF DISPLAY.)

UGETF2:	PUSHJ P,CLKWAT		;At clock level.  Wait a tic and try again
UGETF1:	SKIPN AC1,SPWUUF	;Can we wait?
	SKIPE AC1,INTACT
	 JRST UGETF3		;  No, allow failure return
	PUSHJ P,FSGET		;Get free storage at user or interrupt level
	 SKIPA AC1,[-1]		;  Failed, perhaps return -1
	POPJ P,
	CONSO PI,77000		;Are we at interrupt level?
	 JRST UGETF2		;  No, must be clock level.
	POPJ P,

; Special case for spacewar mode or user interrupt level
UGETF3:	PUSHJ P,FSGETU		;Get free storage but don't wait
UGETF4:	 SETO AC1,		;  Failure return
	POPJ P,
;BELOW IS THE PROTOTYPICAL P. OF P. CONTROL BLOCK.
;The typical block is defined for the III displays.  Others get various
;cells changed after the prototype is copied to FS.

DEFINE X (A,B) {A←.-PPMODL
		B
		}
PPMODL:  

X PPOSV←,{LVW  -777,YPIII,I,A,2,2}	;POS VECTOR
X ↑TPJMP←, DISJMP	;JMP TO FIRST BLOCK OF PAGE BEING DISPLAYED.
	LVW (7,-17,I)	;NOW DRAW THE CURSOR.  DD EXECUTE sometimes placed here.
	LVW -5,-10	;DD always halts here.
IFE FTGRIN,<
 X ↑DDCW←,<LVW 12,0>	;For DD, this gets a CW 1,46,2,0,3,2
 X DDCW2←,<LVW -5,10>	;For DD, this gets a CW 3,2,4,0,5,0
>;IFE FTGRIN
IFN FTGRIN,<
 X ↑DDCW←,<GW G.LDC,0,G.LSM,0>      ;Channel and subchannel masks inserted here
 X GRCW2←,<GW G.LWM,G.WMV,G.LUM,12> ;Write mode and update mode for Grinnell
 X GRCW3←,<GW G.LEB,GRESIZ,G.LLB,0> ;Set delta-X and -Y for each char.
 X GRCW4←,<GW G.LEA,GRESIZ,G.LLA,0> ;Set initial X and Y positions (stored later)
>;IFN FTGRIN
X PPJMP←,<LVW (-7,7,I)>	;For DD and Grinnell, a jump to text is placed here.
X ↑PPRJMP←, DISJMP	;JMP BACK TO HEADER OR ON TO NEXT CONT. BLK.

X HEDPTR←,0		;POINTER BACK TO PRGM HEADER.
X OUTCNT←,OUTNUM	;BLOCKS REMAINING BEFORE DISK OUTPUT.
X ↑PPNO←,0		;NO. OF THIS P. OF P.
X ↑DPHPOS←,-LINELN	;CHARS. LEFT BEFORE END OF THIS LINE.
X CNT1←,0		;CHARS. REMAINING  BEFORE EXTENSION NEEDED.
X PPTR1←,{POINT 7,0,35}	;CURRENT POINTER FOR PRINTING ON THIS PIECE OF PAPER.
X SPTR1←,0		; SAVED POINTER FOR ZEROING OUT SPACE BEFORE CR
X WCNT←,-INITWC		;FREE WORDS LEFT IN CURRENT BLOCK.
X CBLKPT←,0		;BOTTOM OF CURRENT BLOCK.
X ↑TBLKPT←,0		;FIRST BLOCK CURRENTLY DISPLAYED (AT TOP OF SCREEN)
X FBLKPT←,0		;FIRST BLOCK STILL IN CORE.
X DEL←,2		; NO. OF LINES IN A GLITCH.
X DELCNT←,2		;LINES REMAINING IN CURRENT GLITCH.
X GLCNT←,1		;CURRENT SIZE OF PAGE IN GLITCHES.
X PGSIZ←,14		;NOMINAL SIZE OF PAGE IN GLITCHES.
X PTBEG←,0		; INCREMENT INTO LINE POINTER TABLE
X DDSPT←,0		;POINTS TO SAVED WORD FROM FIRST REFRESHED LINE (DD)
X DDSAV←,0		;SAVED WORD FROM FIRST REFRESHED LINE (DD)
	0
X ↑VPOS←,0		;LINE NUMBER OF CURRENT LINE (ON III, RELATIVE TO PP TOP)
X LLW←,0		;LAST LINE WRITTEN (AS VPOS, GLW, RELATIVE TO PP TOP ON III)
X PTRB←,<XWD AC3,0>	;POINTS TO TABLE OF BYTE POINTERS TO THE FIRST OF EACH LINE (DD)
X PTB←,0		; ACTUAL TABLE ADDRESS
X VP←,0			; VERTICAL POSITION ARGUMENT TO QDD
X SC←,0			; ARGUMENT TO QDD FOR COUNT FIELD ADDRESS
X DPYCHR←,0		; FLAG SAYING AT LEAST ONE CHARACTER HAS BEEN TYPED
X LSTCHR←,12		; LAST CHARACTER DEPOSITED INTO BUFFER
X FAKELF←,0		; -1 IF DTYO HAS JUST INVENTED A LF FOR DPYTYP
X GLW←,0		; GREATEST LINE WRITTEN, FOR ERASING WHEN WE GLITCH
X ↑PPDPY←,0		; LH IS BIT TELLING DISPLAY TYPE, RH IS POSLIN SUBROUTINE
X GLTCH←,0		; FLAG THAT SAYS THE PAGE PRINTER HAS GLITCHED
X PPINV←,0		; FLAG INDICATING PAGE PRINTER POINTERS ARE BEING MODIFIED
X PPENQ←,0		; NUMBER OF TASKS THIS PAGE PRINTER HAS IN THE DD QUEUE
X PPNQT←,0		; COUNT DOWN FOR NON-PAGE PRINTER REQUESTS
X PPVIRG←,-1		; INDICATES VIRGIN PAGE PRINTER
X DMLAST←,0		;Byte pointer to last character queued from this PP
X DMPPXY←,0		;X-Y position for next char output on this PP
X DMGLCH←,0		;Minus number of lines of glitching needed for this PP on DM
X PPYVAL←,YPIII		;Y position for PP, in DPYPOS format
X PPSHGT←,HGTIII	;Height of screen in text lines
X ↑LNLNGT←,LINELN	;LINELENGTH FOR THIS GUY.
;Don't put any cells after LNLNGT because BLKSIZ is defined below from LNLNGT.

; ALL DISPLAY PROGRAM SPACE IS TAKEN FROM A FREE
;  STORAGE AREA CONSISTING OF FIXED SIZE BLOCKS.  THE
; FOLLOWING PARAMETERS RELATE TO THOSE BLOCKS.

↓BLKSIZ←←<<LNLNGT+5+1>!<TRIVIAL-1>>-1	;BLOCK SIZE. THIS IS ARBITRARY, BUT ≥36
↑BLKSIZ←←BLKSIZ
↑PPLINK ←← BLKSIZ-1	;LINKS IN LAST WD OF BLK: XWD BACK,FORWARD
↓BLKBTS ←← PPLINK-1	;MAGIC TYPE BITS FOR BLK GO HERE.
↓GCINFO ←← BLKBTS-1	;INFO FOR THE (HYPOTHETICAL) GARBAGE COLLECTOR
FSBSIZ←←BLKSIZ-2	;BLKSIZ FOR OUTSIDE WORLD.
↑FSLINK←←PPLINK
↓CNT←←GCINFO-2		;MAX. NO. OF `GLITCHES' PER PAGE.
INITWC←←GCINFO-2	;THIS MANY WORDS/BLOCK AVAILABLE FOR PROGRAM.
;DTYO DPYTYO TYO0

;DTYO--CHARACTER IN CHR, DAT POINTS TO P.OF P. CONTROL BLOCK.
;DPYTYO IS CALLED FROM LINED TO ECHO INPUT CHARACTERS AND THEIR CONTROL BITS
;DTYO IS CALLED FROM DPYTYP AT CLOCK LEVEL WITH A CHARACTER FROM THE OUTPUT BUFFER

;THESE ROUTINES PLACE CHARACTERS IN THE DISPLAY'S PIECE OF PAPER TEXT BLOCKS
;DDB MUST POINT TO DPY HEADER

↑↑DPYTYO:
	MOVE DAT,CURPP(DDB)	; PICK UP POINTER TO PAGE PRINTER CONTROL BLOCK
	HLL DAT,DDB		; PUT IN DISPLAY BITS
↑DTYO:	MOVE AC1,LSTCHR(DAT)	; PICK UP LAST CHARACTER TYPED
	TLNN DAT,DDDLIN
	JRST .+3
	CAIN AC1,177		; LAST CHAR A DELETE ON A DD?
	JRST DELNOW		; YES, <DELETE><CHR> IS A SINGLE NORMAL GRAPHIC.
	JUMPE CHR,CPOPJ		;DON'T PRINT NULLS.
	JUMPGE AC1,TYO0		;JUMP UNLESS THE LAST THING WE DID WAS INVENT CRLF.
	CAIN CHR,15		;A CR AFTER WE INVENTED A CRLF?
	POPJ P,			;YES. SUPPRESS IT.
	MOVEI AC1,12		;MAKE IT LOOK LIKE THE LAST CHARACTER WAS LF.
	MOVEM AC1,LSTCHR(DAT)	;SET IT.
	CAIN CHR,12		;CHARACTER IS LF?
	POPJ P,			;YES. SUPPRESS THAT TOO.
				;NOW IT LOOKS LIKE NORMAL CHARACTER, LSTCHR SET.
TYO0:	SETOM DPYCHR(DAT)	; NOTE THAT ANOTHER CHARACTER HAS BEEN PUT INTO PP
	CAIN CHR,15		; IS IT A CR ?
	JRST PR1ECR		; YES, GO SERVICE IT
	JUMPL DAT,TYO1		; IF III, WE CAN SKIP ALL THIS BULLSHIT
	CAIE AC1,12		; WAS LAST CHARACTER A LF?
	JRST TYO1		; NO
;ON DD OR DM, FIRST CHARACTER AFTER LF
	MOVE AC1,DPHPOS(DAT)	; WELL, ARE WE AT THE BEGINNING OF THE LINE?
	ADD AC1,LNLNGT(DAT)
	JUMPE AC1,TYO4		; YES, THERE MUST HAVE BEEN A CR FIRST.
	PUSH P,CHR		; SAVE OUR CHARACTER
	PUSH P,AC1		; SAVE THE COUNT (I.E., COLUMN NUMBER.)
	SETZ CHR,
	DPB CHR,SPTR1(DAT)	; REPLACE LF WITH NULL
	MOVEI CHR,15
	PUSHJ P,PUT2CH		; Put in CR, making sure there is room for LF
	MOVEI CHR,12		; PUT OUR LF BACK
	SOS VPOS(DAT)
	PUSHJ P,PUTCH1
	PUSHJ P,EOLSET		; STORE THE POSITION OF OUR NEWLY MOVED LF
;FALL THRU TO NEXT PAGE
;TYO5 TYO1 TYO2 TYO7 DELNOW IIILED IIILE2

;FELL THRU FROM PREVIOUS PAGE
	MOVEI CHR,40		;TYPE A BUNCH OF SPACES TO SIMUALTE A BARE LF.
TYO5:	PUSHJ P,PUTCH1		;SEND A SPACE.
	SOSLE (P)		;DECREMENT THE SPACE COUNT.
	JRST TYO5		;LOOP SPACING.
	SUB P,[1,,1]		;ADJUST STACK TO REMOVE SPACE COUNT.
	POP P,CHR		;RESTORE CHARACTER. FALL INTO TYO1
TYO1:	CAIN CHR,12		; OR A  LINE FEED ?
	JRST PR1EOL		;YES.
	JUMPL DAT,TYO2		; IF III, JUST PUT THE CHARACTER IN THE BUFFER
	MOVE AC1,DPHPOS(DAT)	; ARE WE AT THE LEFT MARGIN?
	ADD AC1,LNLNGT(DAT)
	JUMPN AC1,TYO2		; NO
	MOVE AC1,LSTCHR(DAT)	; YES, WAS LAST CHARACTER A LF?
	CAIN AC1,12
	JRST TYO2
	PUSH P,CHR		; NO, PUT ONE IN!
	MOVEI CHR,12
	PUSHJ P,PUTCH1
	SOS LHCNT(DDB)		;DECREMENT LINE COUNTDOWN FOR AUTO HOLDING
	PUSHJ P,EOLSET		; STORE LINE POINTER
	SOSG DELCNT(DAT)	; TIME TO GLITCH YET?
	PUSHJ P,PREOGL		; YES, DO IT.
	POP P,CHR
TYO2:	CAIN CHR,11		; TAB?
	PUSHJ P,PR1TAB		; YES, GO EXPAND IT.
	PUSHJ P,PUTCH1		; PUT CHARACTER INTO BUFFER
TYO7:	MOVEM CHR,LSTCHR(DAT)	; SAVE LAST CHARACTER
	TLNN DAT,DDDLIN
	JRST .+3
	CAIN CHR,177		;IS THIS A DELETE?
	JRST .+3		;YES. FOR DD AVOID CHANGING THE H.POSITION.
	AOSL DPHPOS(DAT)	;UPDATE HORIZONTAL POS.
	JRST PRCR		;OVER END OF LINE..  INSERT CR LF.
IFN FTDD,<
	PUSHJ P,IIILED		;Position line editor if on III
	MOVE AC1,[CW 0,0,3,2,3,2]
	TLNE DAT,DDDLIN		; IF WE ARE A DD
	MOVEM AC1,TPJMP+1(DAT)	; AND THE LINE DOESN'T END WITH CRLF, PUT IN AN EXECUTE
>;IFN FTDD
	POPJ P,

;DD. LAST CHARACTER WAS A DELETE. THIS CHARACTER WILL MAKE AN ORDINARY GRAPHIC.
DELNOW:	PUSHJ P,PUTCH1		;PUT CHARACTER IN BUFFER
	IORI CHR,200		;MAKE IT SPECIAL SO WE WON'T COMPARE EQUAL TO IT
	JRST TYO7

;Here to update display position of III line editor at end of current PP.
;Call with DDB pointing to dpy hdr, DAT pointing to PP of interest.
;Clobbers only AC1.
IIILED:
IFE FTF2,<
	SKIPN III(DDB)
	POPJ P,			;Do nothing if not on III
	HRRZ AC1,CURPP(DDB)
	CAIE AC1,(DAT)
	POPJ P,			;Not current PP
	PUSH P,AC3
	MOVE AC3,VPOS(DAT)	;Get current line number, relative to top of PP
	IMUL AC3,[-30B21]	;Times adjustment per line
	ADD AC3,[-10B21]	;Move LE display down 1/3 line
	ADD AC3,PPOSV(DAT)	;Add in saved position word (for top of PP)
	MOVE AC1,DPHPOS(DAT)	;Get number of columns left on last line
	ADD AC1,LNLNGT(DAT)	;Make it into X-position in columns
	IMULI AC1,14		;Times adjustment per column
	SUBI AC1,777		;Plus position of left margin
	DPB AC1,[POINT 11,AC3,10] ;Put into III position word
	MOVEM AC3,LEDPOS(DDB)	;Put position word into dpy hdr
	POP P,AC3
>;IFE FTF2
	POPJ P,
;TYO4 PR1TAB PR1TB1

;HERE ON DD OR DM IF THE LAST CHARACTER WAS A LF AND WE ARE AT THE LEFT MARGIN
;CURRENT CHAR IS NOT A CR
TYO4:	CAIE CHR,12		; IS THIS CHARACTER A LF?
	JRST TYO2		; NO, JUST DUMP THE CHARACTER IN THE BUFFER
	PUSHJ P,PR1EC2		; YES, PUT IN A SPACE AND A CR AND A LF
	MOVEI CHR,12		; AND THEN A LF
	MOVEM CHR,LSTCHR(DAT)
	POPJ P,

;WE GET HERE TO PRINT SPACES FOR A TAB
PR1TAB:	SETCM AC1,DPHPOS(DAT)	;GET CURRENT HORIZONTAL POSITION.
	SUB AC1,LNLNGT(DAT)	; MAKE TABS START IN COLUMN 8
	ANDI AC1,7		;GET NO. OF SPACES TO NEXT MULTIPLE OF 8 BOUNDARY.
	ADDM AC1,DPHPOS(DAT)	;UPDATE HIM.
	TLNE DAT,DMLIN		;DATAMEDIA DISPLAY?
	POPJ P,			;YES, IT HAS HARDWARE TABS! (WHICH WE HAVE SET)
	PUSH P,AC1		;PUT COUNT OF EQUIVALENT SPACES ON STACK
	PUSHJ P,PUTCH1		;FIRST PRINT THE TAB.
	MOVEI CHR," "		;NOW OUTPUT RIGHT NUMBER OF SPACES.
PR1TB1:	PUSHJ P,PUTCH1		;NOW EMIT A SPACE.
	SOSL (P)		;..AND SOME MORE, IF APPROPRIATE.
	JRST PR1TB1
	MOVEI CHR,11		;WE WILL FINISH OFF WITH ANOTHER TAB.
	SUB P,[1,,1]		;DISCARD COUNT FROM STACK
	POPJ P,
;PRCR PRCR3 PRCR2 PUT2CH PUTCH1 PUT2C3 PUT2C4 PUT2C2

;STICK A CRLF IN TO BREAK UP LONG LINES
PRCR:	SKIPL WCNT(DAT)		;Any spare words in this buffer?
	JRST PRCR2		;No, see if room for 2 chars in this last word
PRCR3:	MOVEI CHR,15		;PRINT A CR.
	PUSHJ P,PUTCH1
	MOVEI CHR,12		;NOW INVENT A LINE FEED.
	PUSHJ P,SETLL		; RESET DPHPOS
	PUSHJ P,PR1EOL		;GO DO THE END-OF-LINE BIT
	SETOM LSTCHR(DAT)	;FLAG THAT WE INVENTED CRLF HERE.
	POPJ P,			;(DPYTYP WILL WAIT FOR LINE BEFORE SENDING MORE)

;Last char of long line and CRLF must all be in same buffer for DM at least.
PRCR2:	MOVE AC1,CNT1(DAT)	;Get number of bytes left + 1
	CAILE AC1,2
	JRST PRCR3		;Room still for at least 2 more chars
	LDB CHR,PPTR1(DAT)	;Get back last char
	SETZ AC1,
	DPB AC1,PPTR1(DAT)	;And replace it in buffer with a null
	PUSHJ P,PUT2C3		;Get new buffer and stick in last char
	JRST PRCR3		;Now put CRLF into new buffer

;Here to make sure there is room in current buffer for at least 2 chars (CRLF)
PUT2CH:	SKIPL WCNT(DAT)		;Any spare words in this buffer?
	JRST PUT2C2		;No
PUTCH1:	SOSG CNT1(DAT)		;Print CHR without special character checking
PUT2C3:	PUSHJ P,EXTBUF		;GO EXTEND BUFFER, OR GET NEW ONE IF NEEDED
	IDPB CHR,PPTR1(DAT)
IFN FTDDLOSS,<
PUT2C4:	CAIN CHR,15		;Insert CR after CR
	TLNN DAT,DDDLIN
	POPJ P,
	MOVEI CHR,400015	;Avoid recursion with CR after THIS cr
	PUSHJ P,PUTCH1		;Put out extra CR
	MOVEI CHR,15		;Restore CR in case someone wants it
>;IFN FTDDLOSS
	POPJ P,

;We are now in last word of buffer--see if there is room in this word for 2 chars
PUT2C2:	SOS AC1,CNT1(DAT)	;Decrement count of unused room in buffer
	SOJLE AC1,PUT2C3	;Jump if not enough room
	IDPB CHR,PPTR1(DAT)	;Room for at least 2 chars in this word--put in one
IFN FTDDLOSS,<
	JRST PUT2C4
>;IFN FTDDLOSS
IFE FTDDLOSS,<
	POPJ P,
>;IFE FTDDLOSS
;PR1ECR PR1EC1 PR1EC3 SETLL

;Here on CR
PR1ECR:	JUMPL DAT,PR1EC1	; IIIs are simple
	TLNE DAT,DDDLIN		; IS THIS A DD?
	SETZM TPJMP+1(DAT)	; YES, LINE ENDS WITH CRLF, SO KILL THE EXECUTE
	MOVEI AC1,12		; WAS THE LAST CHARACTER A LF
	CAME AC1,LSTCHR(DAT)
	JRST PR1EC1
	MOVN AC3,DPHPOS(DAT)	; PICK UP THE HORIZONTAL POSITION
	CAMN AC3,LNLNGT(DAT)	; ARE WE AT THE BEGINNING OF THE LINE?
	JRST PR1EC2		; YES, NO NEED FOR ANY MORE CR'S, BUT PUT IN SPACE
	SOS VPOS(DAT)
	SETZ AC1,
	DPB AC1,SPTR1(DAT)	; Put a NULL in over the LF
	PUSHJ P,SETLL		; RESET DPHPOS
	MOVEI CHR,15
	PUSHJ P,PUT2CH		; Put in CR, making sure there is room for LF
	MOVEI CHR,12
	PUSHJ P,PUTCH1		; STICK THE LF IN
	MOVEM CHR,LSTCHR(DAT)	; SAVE IT
	JRST EOLSET		; DO THE END-OF-LINE BIT

;Here on any CR on III or on CR after non-LF on DD or DM
PR1EC1:	MOVN AC3,DPHPOS(DAT)	; NOW (SIGH) SEE IF WE ARE AT THE LEFT MARGIN!
	CAMN AC3,LNLNGT(DAT)
	POPJ P,			; IF SO, FLUSH THIS CR
	PUSHJ P,SETLL		; RESET DPHPOS
	PUSHJ P,IIILED		; Position line editor if on III
	JUMPL DAT,PUTCH1	; Don't invent LFs on III--let him overtype lines
PR1EC3:	PUSHJ P,PUT2CH		; Put in the CR, making sure there is room for LF
	SETOM LSTCHR(DAT)	; Flag that we invented a LF
	MOVEI CHR,12
	JRST PR1EO2

;INITIALIZE LENGTH OF THE LINE AT CR.
SETLL:	MOVN AC1,LNLNGT(DAT)	;GET -LINELENGTH.
	MOVEM AC1,DPHPOS(DAT)	;RESET HORIZONTAL POS.
	POPJ P,
;PR1EC2 PR1EOL PR1EO2 PREOGL

;GET HERE IF THE LAST CHARACTER WAS A LF AND WE ARE AT THE LEFT MARGIN ON DD OR DM
PR1EC2:	MOVEI CHR,40		; PRINT A SPACE SO THE LINE WILL GET ERASED
	TLNE DAT,DDDLIN
	PUSHJ P,PUTCH1		;ONLY NEED SPACE ON DD
	MOVEI CHR,15
	JRST PR1EC3

; HERE ON LF
PR1EOL:	TLNE DAT,DDDLIN		; IS THIS A DD?
	SETZM TPJMP+1(DAT)	; YES, NO NEED FOR AN EXECUTE AT END OF BUFFER
	MOVEM CHR,LSTCHR(DAT)	; SAVE THIS CHARACTER
PR1EO2:	PUSHJ P,PUTCH1		;PUT IN LF
	SOS LHCNT(DDB)		;DECREMENT LINE COUNTDOWN FOR AUTO HOLDING
	PUSHJ P,EOLSET		;SET VERTICAL POSITION AND SAVE BYTE PTR
	PUSHJ P,IIILED		;Position line editor if on III
	SOSLE DELCNT(DAT)	;ARE WE AT THE TOP OF A GLITCH ?
	POPJ P,			;NO. GO BACK.
PREOGL:	MOVE AC3,DEL(DAT)	;GET NO. OF LINES PER GLITCH..
	MOVEM AC3,DELCNT(DAT)	;.. AND INIT. THE COUNT.
	AOS AC1,GLCNT(DAT)	;UPDATE SIZE OF PAGE.
	CAMG AC1,PGSIZ(DAT)	;IS IT TOO BIG ?
	POPJ P,			; NOT YET.
	PUSHJ P,GLITCH		;YES, MOVE IT UP SOME
	JRST IIILED		;NOW UPDATE LINE EDITOR POSITION IF III
;EXTBUF L2 L1 GBLK

BEGIN EXTBUF	;MAKE MORE ROOM IN THE DISPLAY BUFFER.

↑EXTBUF:
	EXCH AC1,PPTR1(DAT)	;GET BYTE POINTER.
L2:	MOVN AC2,WCNT(DAT)	;HOW MANY WORDS LEFT IN THIS BLOCK ?
	JUMPE AC2,GBLK		;IF NONE, GET A NEW BLOCK.
	CAILE AC2,10		;IF FEWER THAN 8, USE THAT  NO.
	MOVEI AC2,10		;..ELSE USE 8 WORDS.
	ADDM AC2,WCNT(DAT)	;DECREMENT THE COUNT.
	MOVE AC3,AC2
	ASH AC3,2		;MULTIPLY BY 5 RAPIDLY.
	ADD AC3,AC2
	MOVEM AC3,CNT1(DAT)	;THAT'S THE NEW CHAR. COUNT, FOLKS.
	MOVE AC3,1(AC1)		;PICK UP THE JMP AT CURRENT END OF BUFFER..
	ADDI AC1,1(AC2)		;GET NEW POS. FOR IT...
	MOVEM AC3,(AC1)		;.. AND PUT IT THERE.
	MOVEI AC3,1		;MANUFACTURE A NULL CHAR. WORD...
L1:	SUBI AC1,1		;AND FILL THE NEWLY AVAILABLE AREA OF THE
	MOVEM AC3,(AC1)		;BUFFER WITH IT.
	SOJG AC2,L1
	SUBI AC1,1
	TLZ AC1,760000		;BUG FIX REG RPH 24 JUL 72
	EXCH AC1,PPTR1(DAT)	;RESTORE THINGS TO THEIR RIGHTFUL PLACES.
	POPJ P,

GBLK:  ;;GET ANOTHER BLOCK FROM FREE STORAGE FOR PRGM.
	AOSLE BLKTOT(DDB)	;INC. HIS COUNT OF BLOCKS USED.
	PUSHJ P,FBLK		;OOPS, TOO MANY. FREE SOME.
	PUSHJ P,GETFS		;GET ANOTHER BLOCK FROM FREE STORAGE.
	JUMPL AC2,GBLKFA	;WE DON'T KNOW HOW TO RECOVER IF WE CAN'T GET FS
	HRR AC1,AC2		;MAKE THE BYTE PTR. POINT THERE.
	EXCH AC2,CBLKPT(DAT)	;UPDATE CURRENT BLK. PTR (AND GET OLD ONE).
	MOVEI AC3,CBLKBT	;GC BIT FOR `CURRENT PP BLOCK'...
	ANDCAM AC3,BLKBTS(AC2)	;..TURN IT OFF IN OLD BLOCK.
	MOVEM AC3,BLKBTS(AC1)	;.. AND PLACE IN NEW ONE.
	MOVE AC3,GCINFO(AC2)	;GIVE NEW BLK. SAME GC CODE AS
	MOVEM AC3,GCINFO(AC1)	; OLD ONE.
	MOVNI AC3,INITWC	;SET UP NO. OF FREE WORDS IN NEW BLOCK.
	MOVEM AC3,WCNT(DAT)
	MOVE AC3,INITWC(AC2)	;PICK UP RETURN JMP FROM END OF OLD BLK..
	MOVEM AC3,(AC1)		;.. AND PUT IN FIRST WORD OF NEW ONE.
	HRRM AC1,PPLINK(AC2)	;MAKE FORWARD LINK OF OLD ONE POINT AT NEW ONE.
	HRLM AC1,INITWC(AC2)	;MAKE JMP AT END OF OLD ONE POINT AT NEW ONE.
	HRLZM AC2,PPLINK(AC1)	;BACKWARD LINK OF NEW ONE TO OLD ONE...
	SOJA AC1,L2		;JIGGLE NEW BYTE PTR. A BIT AND PROCEDE.

GBLKFA:	PUSHACS
	PUSHJ P,DISGST		;PRINT TIME OF NEW MESSAGE ON CTY
	PUSHJ P,DISMES
	ASCIZ /Couldn't get FS at EXPBUF! /
	PUSHJ P,DISFLUSH
	POPACS
	PUSHJ P,FDDTCA
	HALT .

BEND EXTBUF.